Solved: Problem using PDFcreator 0.9.7 with Excel 2007

[arimax926]

Hello,
I am trying to print multiple worksheets to a single PDF file using the VBA code by Ken Puls at www dot excelguru dot ca slash node slash 21 (I am running Excel 2007 using a test workbook with 2 worksheets with few words in them). This is the code:

VBA
Sub PrintToPDF_MultiSheetToOne_Early()
'Author : Ken Puls (site)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from site)
' Designed for early bind, set reference to PDFCreator
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
'/// Change the output file name here! ///
sPDFName = "Consolidated.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator
'Make sure the PDF printer can start
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "Error!"
Exit Sub
End If
'Set all defaults
With pdfjob
.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
lTtlSheets = Application.Sheets.Count
For lSheet = 1 To Application.Sheets.Count
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo 0
Next lSheet
'Wait until all print jobs have entered the print queue
[BREAKPOINT] Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
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
End Sub

The main problem is that when the jobs are sent to the PDF printer, it doesn't seem to do the work expected. So, after some seconds I get the alert message "Microsoft Excel is waiting for another application to do an OLE function" and it repeats regularly, entering a never ending loop. PDFcreator is launched by the code (I can see it in the running applications) but I can't understand why it doesn't print the jobs and save the file. If I insert a breakpoint in the code (just before the first DO...LOOP cicle) and proceed step by step everything works fine! Any explanation?

Then a second question arises. PDFcreator seems not to use the page layouts I define for each worksheet. I read a previous post about this problem here (Page set up in PDF-Creator software), but I don't know if it applies to my problem and how to use the function "SetupPrint": what I have to pass to it? How to combine this code with the previous routine?
Sorry if my questions seem quite naive, but I am not a VBA expert, so I will appreciate very much any suggestion.
Thank you!

[Bob Phillips]

Why bother, MS provide a PDF plugin for 2007 at http://www.microsoft.com/downloads/d...displaylang=en

[arimax926]

I didn't know there was a special add-in from MS, but more comfortable using the routine above. Furthermore I am not sure I can use it from VBA code to do the things I need (I'll try if I get no answer to my post).
Anyway thank you for the suggestion.

[Bob Phillips]

I would have thought that you just format an Excel sheet exactly as you want it to appear, and print it using the addin?

[mdmackillop]

I've found problems with multi-sheet printing as well. This is my solution using PDF995. Perhaps you can adapt it (or change your PDF printer!)
Apologies for the "user specific" stuff.



[VBA]
Option Explicit
'Read INI settings
Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
'Write settings
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public FPath As String
Sub pdfwrite()
Dim iniFileName As String, tmpPrinter 'As Printer
Dim OutputFile As String, x As Long
Dim RepNo As String
Dim sh As Worksheet
Dim b As Long
With ActiveWorkbook
If UCase(Left(.Name, 7)) = "VALBOOK" Then
MsgBox "Create report first"
Exit Sub
End If
End With
For Each sh In Sheets
sh.PageSetup.BlackAndWhite = False
Next sh
With Range("M11:Q15")
.Interior.ColorIndex = 6
For b = 7 To 10
With .Borders(b)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next
End With
'Delete last printed file
If Len(Dir("C:\PDF995\Temp.ps")) > 0 Then
Kill "C:\PDF995\Temp.ps"
End If
RepNo = ActiveWorkbook.Path & "\" & "Cost Report " & InputBox("Report number") & ".pdf"
Name "c:\pdf995\res\pdf995.ini" As "c:\pdf995\res\pdf995.tmp"
FileCopy "c:\pdf995\res\pdf995.xxx", "c:\pdf995\res\pdf995.ini"
' set the location of the PDF995.ini
iniFileName = "c:\pdf995\res\pdf995.ini"
' save current settings from the PDF995.ini file
' setup new values in PDF995.ini
x = WritePrivateProfileString("PARAMETERS", "UserFile", RepNo, iniFileName)
x = WritePrivateProfileString("PARAMETERS", "Output File", RepNo, iniFileName)
x = WritePrivateProfileString("PARAMETERS", "Uset File", RepNo, iniFileName)
' change the default printer to PDF995
tmpPrinter = Application.ActivePrinter
Application.ActivePrinter = "PDF995 on Ne00:"
'print the report
ActiveWorkbook.Sheets("FinStat").PrintOut
Range("N12") = "Printing FinStat...."
Pauses 5
ActiveWorkbook.Sheets("Instruct").PrintOut
Range("N12") = "Printing Instruct...."
Pauses 5
ActiveWorkbook.Sheets("Varies").PrintOut
Range("N12") = "Printing Varies...."
Pauses 5
With Range("M11:Q15")
.Interior.ColorIndex = 2
.Borders.LineStyle = xlNone
End With
Range("N12").ClearContents
' restore the original default printer and the PDF995.ini settings
Kill "c:\pdf995\res\pdf995.ini"
Name "c:\pdf995\res\pdf995.tmp" As "c:\pdf995\res\pdf995.ini"
On Error Resume Next
Application.Printer = tmpPrinter
ActiveWorkbook.FollowHyperlink RepNo
End Sub
Sub Pauses(PauseTime As Long)
Dim start
start = Timer ' Set start time.
Do While Timer < start + PauseTime
DoEvents ' Yield to other processes.
Loop
End Sub
Function ReadINIfile(sSection As String, sEntry As String, sFilename As String) As String
Dim x As Long
Dim sDefault As String
Dim sRetBuf As String, iLenBuf As Integer
Dim sValue As String
'Six arguments
'Explanation of arguments:
'sSection: ini file section (always between brackets)
'sEntry : word on left side of "=" sign
'sDefault$: value returned if function is unsuccessful
'sRetBuf$ : the value you're looking for will be copied to this buffer string
'iLenBuf% : Length in characters of the buffer string
'sFileName: Path to the ini file
sDefault$ = ""
sRetBuf$ = String$(256, 0) '256 null characters
iLenBuf% = Len(sRetBuf$)
x = GetPrivateProfileString(sSection, sEntry, _
sDefault$, sRetBuf$, iLenBuf%, sFilename)
ReadINIfile = Left$(sRetBuf$, x)
End Function

[/VBA]

[arimax926]

Thank you mdmackillop. I solved the first part of my question using your Pauses routine instead of the last DO...LOOP cicle:

[VBA]
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
[/VBA]

Calling "Pauses 5" instead of the above cicle seems to work in the Ken's code.
Now the only problem left is how to say to PDF creator to use the page layout I defined in the worksheets. Any suggestions?
Thank you.

[mdmackillop]

Can you post a sample layout?

[arimax926]

Sorry, I was wrong. The layout is printed as expected. But using the final code in a more complex workbook seems to bring some problem related to the timing of the Puase. I think I only have to understand how long the pause should be (according to number of sheets and stuff to print). The value passed to the Pause routine are seconds?
Thank you.

[mdmackillop]

The value passed to the Pause routine are seconds?

Yes. You can get the number of pages somewhere (don't recall where) which you might use to avoid massive pauses for all sheets.
I also toyed with checking to see if the output file was created, but couldn't get it to work.

[arimax926]

Thank you very much for your help!

[Bob Phillips]

Yes. You can get the number of pages somewhere (don't recall where) which you might use to avoid massive pauses for all sheets.

[vba]

NumPages = ExecuteExcel4Macro("Get.Document(50)")
[/vba]