I haven't tested this, but I think it should work. I've added a loop to check the count of worksheets in the print queue before moving on to the next sheet. That should slow it down to ensure that things don't go out of order:
Code:
'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
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
Let me know if that helps,
Bookmarks