Bij bepaalde celwaarde, Messagebox Ja/nee

[mark1987vw]

Ik heb een vraag over VBA waarin verschillende functies gecombineerd moeten worden.
Maar ik kom er door gebrek aan kennis niet uit want hij blijft foutmeldingen geven.
Ik ga het proberen zo goed mogelijk uit te leggen.

Ik heb een lijst gemaakt waarin verschillende taken moeten worden afgevinkt. Wanneer al deze taken zijn afgevinkt wil ik dmv =Als() Cel F1 de waarde 100 geven. Dit kan overigens elke waarde zijn of tekst maar deze code vond ik op het internet dus ik dacht dat is makkelijk om hier mee verder te gaan.

Dan komt het volgende wanneer deze waarde is bereikt moet er een MsgBox ja/nee geopend worden. Met in deze de vraag of ze de werkmap willen opslaan, aangezien alles voltooid.

*Nee: Terug naar de werkmap en voor de rest niks
*Ja: Opslaan als: "Afsluitlijst 25" (Waarin 25 de dag is uit de maand, in dit geval van 25 oktober), Dit zal in de praktijk betekenen dat er nooit meer dan 31 bestanden opgeslagen zijn en dat die de volgende maand het bestand met bijvoorbeeld 25 automatisch overschrijft.
Het bestand moet opgeslagen worden op locatie: Y:\Restaurant

Hier heb ik een code proberen te maken waarin verschillende codes zijn gecombineerd maar dit werkt uiteraard niet en ik weet niet hoe ik het wel moet doen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Antwoord As String
Dim Dialoog As String
Set oRange = Range("F2")
Dialoog = "Je hebt alle velden afgevinkt. Wil je het bestand opslaan ?"

If Intersect(Target, oRange) Is Nothing Then Exit Sub
If Target.Value = 100 Then


MsgBox(Dialoog, vbQuestion + vbYesNo, "Opslaan bestand")
If Antwoord = vbYes Then

Pad = "Y:\Restaurant\"
Doc = "Afsluitlijst" + " " & Range("A2").Value & "-" & ".xlsm"
ActiveWorkbook.SaveAs Filename:=Pad & Doc

Else




End If
End Sub

Waarschijnlijk is het wat ik probeer heel omslachtig en ik hoop dan ook dat jullie mij kunnen helpen!

Bedankt alvast!

 

[edmoor]

Plaats een voorbeeldbestand en vertel er ook bij welke foutmelding(en) je krijgt.
De Intersect is niet nodig als je op maar 1 cel checked.
Gebruik daarnaast om strings aan elkaar te plakken geen + maar een & teken.
Antwoord = hoort op dezelfde regel voor de Msgbox te staan.
Ook is die Else overbodig en mis ik een End If.

Zonder je voorbeeld bestand:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0,0) <> "F2" Then Exit Sub
    If Target.Value = 100 Then
        If MsgBox("Je hebt alle velden afgevinkt. Wil je het bestand opslaan?", vbQuestion + vbYesNo, "Opslaan bestand") = vbYes Then
            ActiveWorkbook.SaveAs Filename:="Y:\Restaurant\" & "Afsluitlijst " &  Range("A2") & "-" & ".xlsm"
        End If
    End If
End Sub

Hou er ook rekening mee dat je op die manier niet meer in je originele document verder werkt maar in de opgeslagen versie.

 

[mark1987vw]

Bedankt voor je snelle antwoord. Ik heb je code gebruikt en dit werkte goed. Nu werkt het alleen niet in een formule.
Wat ik heb gedaan. Wanneer een bepaalde waarde in Kolom D, E of F aangevinkt is dan geeft die de waarde 1 in cel H van de desbetreffende rij. Dit doel ik op alle rijen die afgevinkt moeten worden om vervolgens de lege rijen te tellen. Wanneer dit getal 0 is dan zou die de code die je hebt bedacht uitgevoerd moeten worden. Maar dan doet die het niet. Wanneer ik in Cel H4, 0 typ doet die het wel.

Ik heb je code dan ook een heel klein beetje aangepast.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "H4" Then Exit Sub
    If Target.Value = 0 Then
        If MsgBox("Je hebt alle velden afgevinkt. Wil je het bestand opslaan?", vbQuestion + vbYesNo, "Opslaan bestand") = vbYes Then
            ActiveWorkbook.SaveAs Filename:="Y:\Restaurant\" & "Afsluitlijst " & Range("A2") & "-" & ".xlsm"
        End If
    End If
End Sub

Waarschijnlijk is dit zwaar omslachtig maar dit is een beetje mijn gebrek aan kennis van VBA.


Ja klopt hier van ben ik op de hoogte.

Vraag 2:

Aangezien dat mijn bestand 8,2 mb is. Krijg ik hem niet geupload. Dus heb hem via Wetransfer geupload. Enig idee waarom deze zo groot is ?
https://we.tl/t-C2C0MqB2f4

Ik heb het tabblad warme kant verwijderd en dan blijft er nog ruim 2mb over (wat ik nog veel vind). Maar waarom is 1 tablad ongeveer 6 mb groot ?
In de Wetranfer link in ieder geval incl. tablad 'warme kant'.

Bedankt in ieder geval!

 

[edmoor]

Een voorbeeld document is uiteraard nooit het originele document.
Alleen een documentje waarin je vraag/probleem duidelijk is.

 

[mark1987vw]

edmoor
Een voorbeeld document is uiteraard nooit het originele document.
Alleen een documentje waarin je vraag/probleem duidelijk is.

Oke bij deze een apart document.
Maar enig idee waardoor mijn document 8,2 mb groot is ?
En dan vooral waarom 1 tabblad meer dan 5 mb groot is.

Zover ik weet zijn alle 4 de tabbladen net zo groot.

Bijgevoegd een voorbeeld bestand.

2 problemen.
1. Hij pakt de waarde 0 van de cel niet dmv een formule. Alleen wanneer ik die formule er opnieuw inzet
2. Bij de datum wil ik alleen de dag hebben (Dus in het geval van vandaag 25.), nu pakt die de gehele datum.

 

[edmoor]

Als een functie de waarde van een cel wijizigt dan triggert dat niet het Change event.
Bij de functie Vandaag() in B2 staat alleen 25, dus dat is goed.

De grootte van je document valt weinig over te zeggen zonder deze te zien.
Heb je er soms plaatjes in zitten?

 

[mark1987vw]

Maar ook bij B2 pakt die de gehele datum als ik die gebruik. Dus ik weet niet hoe ik dit dan oplos

Nee staan geen afbeeldingen in. Ik heb om het bestand netter te maken alle cellen aan de onderkant, dus tot A1048576 en alle cellen aan de zijkant verborgen.
Nu krijg ik die niet weg.

Enig idee hoe ik dat doe want ik heb alles geselecteerd en vervolgens verwijderd maar hij blijft doorscrollen tot helemaal onderaan.
Het lijkt dus alsof er heel veel cellen actief zijn

 

[edmoor]

Als ik hier in je voorbeeld document 01-01-2020 in B2 invul staat er 01, dus wat je wil.

Over je originele document kan ik zo niks zeggen, maar het lijkt er onderdaad op dat Excel denkt dat alle cellen tot het maximaal aantal regels in gebruik zijn.
Dan wordt een document inderdaad groot.
Maak een nieuw Blad, kopieer daar het juiste bereik van dat grote blad naar toe en verwijder dan dat grote blad.

 

[VenA]

Kan je even stoppen met quoten? Het is nu totaal onleesbaar. Nog beter haal alle quotes weg.

 

[mark1987vw]

Als ik hier in je voorbeeld document 01-01-2020 in B2 invul staat er 01, dus wat je wil.

Over je originele document kan ik zo niks zeggen, maar het lijkt er onderdaad op dat Excel denkt dat alle cellen tot het maximaal aantal regels in gebruik zijn.
Dan wordt een document inderdaad groot.
Maak een nieuw Blad, kopieer daar het juiste bereik van dat grote blad naar toe en verwijder dan dat grote blad.

De grote van het bestand is opgelost. inderdaad plakken, kopiëren naar een ander blad is gelukt.

Datum:

Wat betreft de datum. In b2 staat inderdaad dan 01. Dat is wat ik bedoel maar wanneer ik deze cel gebruik om de naam te geven als opslag locatie dan pakt die alsnog 01-01-2020 en niet alleen 01.

Opslaan wanneer alles is afgevinkt

Mijn oplossing was dus om wanneer alles is afgevinkt een waarde te creëren waardoor de vba code wordt getriggerd. Dus in dit geval wanneer waarde 0 in de desbetreffende cel staat dan moet de messagebox omhoog komen met de vraag of deze moet worden opgeslagen. Nu doet hij dit dus niet op de manier hoe ik dit wil.
Is er mogelijk een andere manier om dit voor elkaar te krijgen.

In het originele bestand staan op verschillende plekken vinkjes. dus dat is anders dan in het voorbeeld bestand.
Ik hoop dat je toch nog even naar het originele bestand voor me zou willen kijken en mogelijk een oplossing voor me hebt.

Het originele bestand is nu veel kleiner.

Nogmaals super bedankt voor alle hulp!

 

[mark1987vw]

Kan je even stoppen met quoten? Het is nu totaal onleesbaar. Nog beter haal alle quotes weg.

Sorry, dacht dat het juist overzichtelijker zou worden.
Excuses voor nog een quote

 

[huijb]

Alle papegaai reacties verwijderd, oftewel de onnodige quotes verwijderd.

 

[VenA]

Zoals al geschreven door edmoor moet je het triggeren van een event ergens anders laten plaatsvinden. Met format kan je de inhoud van een cel opmaken.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Range("H4") = 0 Then
    If MsgBox("Je hebt alle velden afgevinkt. Wil je het bestand opslaan?", vbQuestion + vbYesNo, "Opslaan bestand") = vbYes Then
        ActiveWorkbook.SaveAs Filename:="Y:\Restaurant\" & "Afsluitlijst " & Format(Range("A2"), "ddd") & "-" & ".xlsm"
    End If
  End If
End Sub

 

[mark1987vw]

Ik weet echt een klein beetje van VBA, dus hoe je iets moet triggeren dat wist ik niet.

Maar top super bedankt dit werkt!