Sub Ticket()
Blad = Sheets("Scanblad").Range("H13").Value
Topdir = "C:\printout"
If Not Evaluate("ISREF('" & Blad & "'!A1)") Then
MsgBox "Het blad " & Blad & " bestaat niet", vbCritical, "Probleempje"
Exit Sub
End If
Doelmap = Topdir & "\" & Blad
[COLOR="#008000"]'Controleer of de doelmappen bestaan[/COLOR]
If Dir(TopDir, vbDirectory) = "" Then
MkDir TopDir
End If
If Dir(TopDir & "\" & Blad, vbDirectory) = "" Then
MkDir Doelmap
End If
[COLOR="#008000"]'Bestandsnaam deelnemer[/COLOR]
pdf = Doelmap & "\" & Blad & " " & Sheets("Scanblad").Range("H3") & ".pdf"
'Check op aanwezigheid PDF
If Dir(pdf) <> "" Then
If MsgBox("Een PDF in printout bestaat al." & vbCrLf & "Alsnog opslaan?", vbQuestion + vbYesNo, "PDF bestaat al") = vbNo Then
Exit Sub
End If
End If
[COLOR="#008000"]'Bewaar het formulier[/COLOR]
Sheets(Blad).ExportAsFixedFormat 0, pdf, , , , , , False
[COLOR="#008000"]'print het formulier naar de printer[/COLOR]
Sheets(Blad).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub