rjplante
02-16-2010, 12:21 PM
I am trying to generate a PDF file from the code below. I have a situation where I mayneed to print 2 pages. I have highlighted to the code in red that I think may be the problem. I have tried the code after the ELSE statement for a single page printout and have got it to work. When I have added the IF/THEN to check for the second page, that is were I have run into trouble. I have the macro run, it hangs/crashes and I have to end the process PDFCreator.exe from the task manager. Then when I go back to the Excel file, it says it can't initialize PDFCreator.
What am I doing wrong in the code?
--------------------
Sub SAVE_TO_PDF()
Application.ScreenUpdating = False
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
'/// Change the output file name here! ///
sPDFName = Range("AF17").Value
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'Check if worksheet is empty and exit if so
If IsEmpty(Range("R52")) Then
MsgBox "PO is not complete. Make sure " & Chr(13) & "all essential fields are complete.", vbExclamation + _
vbOKOnly, "ATTENTION!"
Exit Sub
End If
Set pdfjob = CreateObject("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
'Print the document to PDF
If Range("AB56").Value > 15 Then
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Sheets("PO Page 2").Select
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Sheets("MAIN PO").Select
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 2
DoEvents
Loop
With pdfjob
.cCombineAll
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
Else
If IsEmpty(Range("R52")) Then
MsgBox "PO is not complete. Make sure " & Chr(13) & "all essential fields are complete.", vbExclamation + _
vbOKOnly, "ATTENTION!"
Exit Sub
End If
Set pdfjob = CreateObject("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
ActiveSheet.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
Loop
pdfjob.cClose
Set pdfjob = Nothing
End If
Application.ScreenUpdating = True
End Sub
What am I doing wrong in the code?
--------------------
Sub SAVE_TO_PDF()
Application.ScreenUpdating = False
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
'/// Change the output file name here! ///
sPDFName = Range("AF17").Value
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'Check if worksheet is empty and exit if so
If IsEmpty(Range("R52")) Then
MsgBox "PO is not complete. Make sure " & Chr(13) & "all essential fields are complete.", vbExclamation + _
vbOKOnly, "ATTENTION!"
Exit Sub
End If
Set pdfjob = CreateObject("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
'Print the document to PDF
If Range("AB56").Value > 15 Then
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Sheets("PO Page 2").Select
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Sheets("MAIN PO").Select
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 2
DoEvents
Loop
With pdfjob
.cCombineAll
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
Else
If IsEmpty(Range("R52")) Then
MsgBox "PO is not complete. Make sure " & Chr(13) & "all essential fields are complete.", vbExclamation + _
vbOKOnly, "ATTENTION!"
Exit Sub
End If
Set pdfjob = CreateObject("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
ActiveSheet.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
Loop
pdfjob.cClose
Set pdfjob = Nothing
End If
Application.ScreenUpdating = True
End Sub