Cel inhoud wissen voor afsluiten VBA

[Robert09]

Hallo,

Ik ben druk opzoek naar een code waarbij ik in een aantal cellen de inhoud kan wissen voor het afsluiten.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim cl As Range
For Each cl In Sheets(1).Range("B5,D3,B14,G6,G7,G8,G9,G10,G11,G14,G18,B27,C27,F27,H27,I33,I34,I35,I36,G38,G40")
If cl.Value = Empty Then
MsgBox "Cel " & cl.Address(False, False) & " is niet gevuld.", vbCritical, "Printen afgebroken"
Cancel = True 'Deze regel zorgt voor het daadwerkelijk afbreken van het opslaan
Exit For
End If
Next
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cl As Range
For Each cl In Sheets(1).Range("B5,D3,B14,G6,G7,G8,G9,G10,G11,G14,G18,B27,C27,F27,H27,I33,I34,I35,I36,G38,G40")
    If cl.Value = Empty Then
        MsgBox "Cel " & cl.Address(False, False) & " is niet gevuld.", vbCritical, "Opslaan afgebroken"
        Cancel = True: Exit Sub
    End If
Next
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="P:\Aanvraag garantie\ " & Range("D3") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
       
        
End Sub
     
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Sheets("Blad1").Range("D3") = Sheets("Blad1").Range("D3") + 1
End Sub

Het zou natuurlijk het beste zijn als er een code bij deze

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Sheets("Blad1").Range("D3") = Sheets("Blad1").Range("D3") + 1
End Sub

kan worden toevoegt.

In de bijlage doe ik een voorbeeld bestand er bij.

 

[leofact]

Het wordt mij niet duidelijk welke cellen precies leeg moeten.

Bedoel je de samengestelde range?
Daar zitten samengevoegde cellen in en daardoor werkt ClearContents niet.
Het kan wel als volgt:

Dim c1 As Range
For Each c1 In Range("B5,D3,B14,G6,G7,G8,G9,G10,G11,G14,G18,B27,C27,F27,H27,I33,I34,I35,I36,G38,G40")
     c1 = ""
Next

mvg Leo

 

[Robert09]

Hallo Leo,

Ik wil graag dat de alle verplichte cellen leeg worden gemaakt behalve D3 omdat dit een uniek nummer is en voor het afsluiten met 1 moet worden verhoogt.

Maar het is waarschijnlijk handiger dat bij het openen de cellen worden geleegd.

Weet jij toevallig hoe dit moet ?

Mvg Robert

 

[leofact]

Zelfde verhaal (-D3)
in het workbook open event. Dus:

Private Sub Workbook_Open()
Dim c1 As Range
For Each c1 In Range("B5,B14,G6,G7,G8,G9,G10,G11,G14,G18,B27,C27,F27,H27,I33,I34,I35,I36,G38,G40")
     c1 = ""
Next
End Sub

 

[Robert09]

Oke super !
Alle credits voor jou !

 

[leofact]

Thanx, graag gedaan.