Solved: Printing multiple worksheets to a single pdf file

[andrewvanmar]

Hi all,

I got redirected by Ken Pulse to this site for a specific question I have. (excel 2003)

I found on his site an article on how to print multiple sheets to a singe pdf which is exactly what I need for a project i'm doing.
[I can't post links yet, so i'll do this the convoluted way:
go to www dot excelguru dot ca slash node slash 21 ]

But since I know next to nothing about vba, I can't understand the code well enough to alter it to work on my workbook.5993

What I want to happen is the first 3 sheets ( by name "Information", "IPL Service" and "Signatures and pricing") to be printed in a single PDF file.

What I can't figure out is how to use the code:
where do I enter the sheet names it has to print, and how do I link it to a button (when I tried that i got an internal error).

can anyone help with this? (you'll have my eternal gratitude if that's any incentive :biggrin: )




Option Explicit
Sub PrintToPDF_MultiSheetToOne_Early()
'Author : Ken Puls (link removed)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from link removed)
' 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
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

[Paul_Hossler]

Don't have PDF creator, but for a regular printer if you have multiple worksheets selected (Ctrl+LMB) and Print, you get a single printout.

Might be worth seeing if you can do a single multi-sheet print to PDF creator

Here's the code I got with Recorder


Sub Macro1()
Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")).Select
Sheets("Sheet1").Activate
Application.ActivePrinter = "CutePDF Writer on CPW2:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"CutePDF Writer on CPW2:", Collate:=True
End Sub

[andrewvanmar]

PDFCreator is only included because according to the author of the code it will only work with it, I have no clue why.

A few questions:
third line of code, why does it only say "sheet1" (or is this the code that locates the button?)

4th and 6th line of code: "on cpw2" is that the server where you have cutepdf running? if that is the case, then this line needs to be different for each user (if they have a different program or on a different server)
is that correct? If so then i'll need to figure out how to bypass that.

I'm going to try to insert it into my (test) workbook, and see what happens

:)

[Charlize]

Not tested but you could try this one.Sub PrintToPDF_MultiSheetToOne_Early()
'Author : Ken Puls (link removed)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from link removed)
' 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
'
'added this for the sheetnames that you want to include
'in the printout
'
If Not IsEmpty(Application.Sheets(lSheet).UsedRange) And _
Application.Sheets(lSheet).Name = "Information" Or _
Application.Sheets(lSheet).Name = "IPL Service" Or _
Application.Sheets(lSheet).Name = "Signatures and pricing" 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
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

[andrewvanmar]

Hmmm, well I managed to coupe it to the button, but it gives an application error (naturllay for the cute pdf), it also does this after trying to redirect it to my own pdf prgram. I'm doing something wrong obviously.
Application.ActivePrinter = "adobe pdf on linxadam01

(linxadam01 is the server name)

I'm thinking, once we get this to work, is there a way to make the script check if the pdf printer in the script is available, and if not, make the user choose one?

Posted before seeing charilze's post

[Paul_Hossler]

My test workbook had Sheet1, ..., Sheet5; if you want to try this, you'd need to adapt it to your names.

Similarly, the PDF "printer" here is configured differently.

I was testing if it were possible to select multiple worksheets and then print them to one PDF file using a single "Print" instead of trying to print individual sheets and joining them into a PDF

[andrewvanmar]

@charlize

Thanks this seems to work...almost.

the script selects the sheets, and starts the pdf program, but no save as dialogue appears, no document is saved as pdf. but... it's a step in the right direction :)

[andrewvanmar]

With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache

if autosave= 0 will a save dialogue appear?

[andrewvanmar]

My test workbook had Sheet1, ..., Sheet5; if you want to try this, you'd need to adapt it to your names.

Similarly, the PDF "printer" here is configured differently.

I was testing if it were possible to select multiple worksheets and then print them to one PDF file using a single "Print" instead of trying to print individual sheets and joining them into a PDF

I did the adaptation with the names, that was my test situation..... this isn't as easy as thought.

@ charlize, there seems to be no activity in pdfcreator, it saves nothing, but also there is no doc qeued

[Paul_Hossler]

When I use the PDF "printer" here it asks me for a file name

Instead of looping to add WS to a PDF file, I was able to select multiple sheets and print them all to a file.

As an experiment, you could start to record a macro, select all your sheets (control+click) at once, and then File, Print selecting your PDF printer.

I got the code fragment in my earlier answer, and guessed at how your macro might look.


Worksheets(Array("Information", "IPL Service", "Signatures and pricing")).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDFCreator", Collate:=True

[Charlize]

Final attempt. But you must be sure of the name of the printer. File will be saved to 'Consolidated'.Sub PrintToPDF_MultiSheetToOne_Early()
'Author : Ken Puls (www.excelguru.ca (http://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
'
'Adapted by Charlize for printing certain worksheets (15/06/2007)
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 Sheets(lSheet).Name = "Information" Or _
Sheets(lSheet).Name = "IPL Service" Or _
Sheets(lSheet).Name = "Signatures and pricing" Then
If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
'The text marked as red in line above is the name of your printer
'Could be anything : PDF on server01 or PDFCreator on Network ...
Else
lTtlSheets = lTtlSheets - 1
End If
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo 0
Next lSheet
'Wait until all print jobs have entered the print queue
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

[andrewvanmar]

@charlize
Again one step closer: I added the code, but instead of printing to the pdf creator it printed to my default printer. (strrrrrange....)
After I changed the default printer to the pdfcreator to see what would happen i just get the error message "cant initialise pdfcreator" apparantly, thepdf printer name i entered wasn't right yet.

How do Icheck the printer name? ( i looked in printers and faxes, but the name there is just pdfcreator) and probably more importantly how do I fit it in the code.

There is something else I dont get, unrelated to the code: if I print to pdf manually, it does the whole printing thing along with a filename dialogue, but no location dialogue ( and I can't find the files it has supposedly made. Something I missed there?

@paul
same result, apart from the printing to my colour printer

[Charlize]

@charlize
Again one step closer: I added the code, but instead of printing to the pdf creator it printed to my default printer. (strrrrrange....)
After I changed the default printer to the pdfcreator to see what would happen i just get the error message "cant initialise pdfcreator" apparantly, thepdf printer name i entered wasn't right yet. Have you removed all running instances of pdfcreator from memory. The running tasks in memory may not have any occurances of pdfcreator.

How do Icheck the printer name? ( i looked in printers and faxes, but the name there is just pdfcreator) and probably more importantly how do I fit it in the code. If it is pdfcreator change PDFcreator with your name

There is something else I dont get, unrelated to the code: if I print to pdf manually, it does the whole printing thing along with a filename dialogue, but no location dialogue ( and I can't find the files it has supposedly made. Something I missed there? The file 'consolidate.pdf' is saved in the same directory as the workbook. Workbook must first be saved once to have the path.

@paul
same result, apart from the printing to my colour printer

[andrewvanmar]

I rebooted, this helped: it didn't give the initialise error. the end result though isn't saved in the location of the original workbook, i'll put it on my desktop, to see, since it's on a server, if that makes a difference.

Edit: trying to print the second time failed, apparantly it doesn't complete the process at some point and it remains in memory.
Rebooting again

edit again: I killed the process in taskmanager (yeah I know should have done tht the first time ;-) ) it seems to keep running for some reason.

edit3: it gets odder and odder: I killed the running process again, and opened pdf creator from the start menu: it still had a copy of my document but with the workbooktitle, not consolidated etc. I printed it from there, and that worked.
(atleast the program works)

[Charlize]

Try this one ... First save workbook before hitting the button.

[andrewvanmar]

WOW!!!!! it works!:cloud9:
What did you do different?
if I was certain you're a girl i'd kiss you!:kiss

THank you!!

[Charlize]

WOW!!!!! it works!:cloud9:
What did you do different?
I've put a waittimer after the print command to give the program the time
to receive the printing data.
After combining everything, also a little wait to make sure the program has the time to finish it.
if I was certain you're a girl i'd kiss you!:kiss
Well, in some country's the guys even kiss each other (on the cheek)
THank you!!

[andrewvanmar]

So the timers did the trick! nice!
Is it customary on this forum to redo the code cleaned up so other visitors can easily use it? (replace sheet names with sheet 1 etc) If so, i'll do that.

and the kissing, I lived in a kissing on the cheeck country ( with men that is) but i don't automatically assueme you do too. ;-) But for that remark you get a scraggely kiss on each cheek!

[andrewvanmar]

Ooh, I came with a good last question: if I want the pdf to always have the samename as the active workbook does,
sPDFName = "Consolidated.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator
can that be done with something like Actveworkbook.name?

edit:
Yay! replace "consolidated" with Activeworkbook.name works to make it have the workbook name.and it works!

is there also code to have the script open the folder it is saved to? (something with activeworkbook.path)?

[andrewvanmar]

Thanks for all your help guys!!!!

[Charlize]

Try this version. Will have the name of the workbook + pdf. As a bonus, program will open search explorer with the following searchcriteria : all pdf's in the directory of the active workbook.

Hope you like this one.

[Charlize]

Alternate routine (and much quicker altough it was not originally created for this) originally from Ivan F. Moala and modified (5 %) by me.Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Sub Display_PDF()
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFilter As String
OpenFile.lStructSize = Len(OpenFile)
'// Define your wildcard string here
'// Note we pad the strings with Chr(0)
'// This indicates an end of a string
strFilter = "*.pdf" & Chr(0) & "*.pdf" & Chr(0)
With OpenFile
.lpstrFilter = strFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = ActiveWorkbook.Path
.lpstrTitle = "Display PDF's in Workbook Directory ..."
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
'// User cancelled Do your thing
Exit Sub
Else
'// Do your thing
MsgBox "You can't open pdf files with this function." & vbCrLf & _
"Rightclick the file you want and use 'open with ...'" & vbCrLf & _
"to view the pdf-file you selected.", vbInformation
Call Display_PDF
End If
End Sub

[andrewvanmar]

I couldn't do much with the second one ( i get the error that only comments can come after "end")

the first one looks great but if possible i'd like it to do a much simpler action, just open the active.path location (if that is possible) just sothe whole contents of that folder is shown.
Part of why i would like that better is to ensure people actively see what folder is saved to and not lose it. BTW sorry for not seeing the second page to this thread before now.

[andrewvanmar]

Solved:

I used Richard Schollar's bit of code and inserted it in place of the search window code, after I figured out how your code works.

Charlize, thanks!!! :cloud9: