'Author : Ken Puls ([URL="http://www.excelguru.ca"]www.excelguru.ca[/URL])
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from [URL]http://sourceforge.net/projects/pdfcreator/[/URL])
' Designed for early bind, set reference to PDFCreator
Sub PDF_AutoCreate(ByVal Wbk As Workbook, RptOutName As String, sRptTime As String, iShts As Integer)
Dim sPath As String
Dim i As Integer, j As Integer, aSheets As String
Dim pdfjob As PDFCreator.clsPDFCreator
Dim lSheet As Long
Dim lTotlSheets As Long
Dim bRestart As Boolean
sPath = ThisWorkbook.Sheets("Parameter").[Full_Path_PDF].Value
RptOutName = Replace(RptOutName, ".xlsx", ".pdf") 'Add Extention for pdf file
'Activate error handling and turn off screen updates
On Error GoTo EarlyExit
Application.ScreenUpdating = False
Set pdfjob = New PDFCreator.clsPDFCreator
'Check if PDFCreator is already running and attempt to kill the process if so
Do
bRestart = False
Set pdfjob = New PDFCreator.clsPDFCreator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
'PDF Creator is already running. Kill the existing process
Shell "taskkill /f /im PDFCreator.exe", vbHide
DoEvents
Set pdfjob = Nothing
bRestart = True
End If
Loop Until bRestart = False
'Assign settings for PDF job
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPath
.cOption("AutosaveFilename") = RptOutName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Delete the PDF if it already exists
If Dir(sPath & RptOutName) = RptOutName Then Kill (sPath & RptOutName)
'Print the document to PDF
lTotlSheets = iShts - 1
For lSheet = 1 To iShts - 1
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Wbk.Sheets(lSheet).UsedRange) Then
Wbk.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
'<-- Code added to check if sheet has entered queue before moving on
'Wait until job has entered PDF queue
Do Until pdfjob.cCountOfPrintjobs = lSheet
DoEvents
Loop
'-- Code modification ends -->
Else
lTotlSheets = lTotlSheets - 1
End If
On Error GoTo EarlyExit
Next lSheet
'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = lTotlSheets
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.cCombineAll
.cPrinterStop = False
End With
'Wait until the file shows up before closing PDF Creator
Do
DoEvents
Loop Until Dir(sPath & RptOutName) = RptOutName
Cleanup:
'Release objects and terminate PDFCreator
Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered. PDFCreator" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical, vbOKOnly, "Error"
Resume Cleanup
End Sub