Is het mogelijk deze code zo aan te passen dat hij bij de eerste keer niet gelijk het 2e werkblad verwijderd maar eerst de rest van de code doorloopt en daarna wel telkens het 2e werkblad verwijderd?
Nu voeg ik zelf een leeg werkblad in voor ik de macro activeer, maar helaas wil ik dat ook nog wel eens vergeten....
Nu voeg ik zelf een leeg werkblad in voor ik de macro activeer, maar helaas wil ik dat ook nog wel eens vergeten....
Code:
Sub Efactuur()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
Sheets(1).Select
'zet naam tabblad in cel G1 en vult bedragen in
Dim naam
naam = Worksheets(2).Name ' (2) is tweede tabblad van een sheet
ActiveSheet.Range("G8") = Mid(naam, 1, 6)
Range("J53") = Sheets(2).Cells(Rows.Count, 7).End(xlUp).Value
Range("J56") = Sheets(2).Cells(Rows.Count, 9).End(xlUp).Value
Sheets(Array(1, 2)).Select
Sheets(1).Activate
Worksheets(2).PageSetup.Orientation = xlPortrait
Worksheets(2).PageSetup.Zoom = False
Worksheets(2).PageSetup.FitToPagesWide = 1
Worksheets(2).PageSetup.FitToPagesTall = 99999
With Sheets(1)
.Range("B17") = Format(CreateObject("scripting.filesystemobject") _
.getfolder("C:\Users\D-post\OneDrive\Documenten\D-post\facturen\").Files.Count, "202400000") + 1
.Range("D17").Value = Date
pad = "C:\Users\D-post\OneDrive\Documenten\D-post\facturen\"
.ExportAsFixedFormat xlTypePDF, pad & .Range("B17").Value & ".pdf"
Windows(1).SelectedSheets.Copy
ActiveWorkbook.Close 0
End With
ActiveSheet.PrintOut
Sheets(Array(1, 2)).Select
Dim Bestand As String
Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
Bestand = Environ("TEMP") & "\" & ActiveSheet.Name & " " & Range("B17").Value & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Bestand
mailto = ActiveSheet.Range("G12")
Subject = "Factuur van de maand " & Format(Date - 28, "mmmm")
Body = "Geachte relatie, <br><br>" & _
"Hierbij doen wij u onze factuur toekomen van de door ons verleende diensten van de afgelopen maand. <br>" & _
"Met het vriendelijke verzoek om voor betaling zorg te dragen." _
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.display
signature = .HTMLBody
.To = mailto
.CC = ""
.BCC = "schipperenraamsdonksveer.0052@mailtobasecone.com"
.HTMLBody = "<Body style='color:black(33,38,227);font-family:calibri;font-size:15'></font></p>" & Body & "<br>" & .HTMLBody
.Subject = Subject
.Attachments.Add Bestand
.Send
End With
Kill Bestand
Application.Run "PERSONAL.XLSB!Efactuur.Efactuur"
End Sub