PDF Creator

Sub PDF()
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/
_
projects/pdfcreator/)
'   Designed for early bind, set reference to PDFCreator
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim objWs As Worksheet
Dim vSheets() As Integer
Dim intI As Integer
Dim pemf1 As String
Dim pemf2 As String
Dim pemf3 As String
'/// Change the output file name here! ///
pemf1 = Worksheets("Seite1").Range("E17")
pemf2 = Worksheets("Seite1").Range("G17")
pemf3 = Worksheets("Seite1").Range("A12")
sPDFName = pemf1 & pemf2 & pemf3 & ".pdf"
sPDFPath = ActiveWorkbook.Path '& Application.PathSeparator
'Check if worksheet is empty and exit if so
'If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0    ' 0 = PDF
.cClearCache
End With
With frm_Drucken.Label3
.Visible = True
.Caption = "PDF wird erstellt...Bitte haben sie einen Moment Geduld...."
End With
'Print the document to PDF
For Each objWs In Worksheets
If objWs.Index > 1 Then
ReDim Preserve vSheets(intI)
vSheets(intI) = objWs.Index
intI = intI + 1
End If
Next
If intI > 0 Then
Sheets(vSheets).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Sleep 250
Loop
pdfjob.cClose
Set pdfjob = Nothing
With frm_Drucken
.Label3.Caption = "PDF wurde erfolgreich erstellt!"
End With
End If
End Sub

Gruß
Christian