Macro for all Excel Workbooks to print to PDF


R

Robin Coe

I found the following macro which prints all selected sheets in an Excel workbook into multiple PDFs and names them the Excel Worksheet name. The first test I did it worked perfectly and saved the PDFs in the same folder thatthe Excel workbook was in, which was a folder on my desktop. I then put the macro in a personal.xls in C:\ProgramFiles\MicrosoftOffice\OFFICE12\XLStart and tried a different Excel workbook in a different location. The macro was viewable and allowed me to run it, however, it doesn't appear to havesaved the PDFs. Can someone tell me what I need to change in my code?

Sub Macro1()
Dim N As Long
Dim fileString As String
Dim cellValue As String

With ActiveWindow.SelectedSheets
For N = 1 To .Count
Sheets(.Item(N).Name).Select
cellValue = Trim(Sheets(.Item(N).Name).Range("A1").Value)
fileString = .Item(N).Name & cellValue & ".pdf"
Sheets(.Item(N).Name).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileString
Next N
End With

End Sub
 
Ad

Advertisements

G

GS

You have no idea how many times this subject crops up! I just finished
doing boilerplate routines for output to PDF or XPS. One uses PrintOut
with the XPS Document Writer, and one uses ExportAsFixedFormat. They
both do the same task in the following various ways:

- print/export selected sheets, 1 file per sheet;
- OR print/export a From/To range of sheets to 1 file;
- OR print/export selected sheets (random grouping) to 1 file;
- OR print/export all sheets to 1 file.

- optionally specify a different path;
- optionally time stamp the output file.

Both routines have 'test' routines that allow you to step through, step
over, or comment out unwanted output configs. The PrintTo_FixedFormat
routine works in all versions of Excel, and the SaveAs_FixedFormat
checks version before it runs.

Here's the code...


Sub SaveAs_FixedFormat(FileType&, Filename$, Settings, _
Optional IsGroup As Boolean = False, _
Optional FromToRng, Optional StampIt As
Boolean = True)
' Saves the following via ExportAsFixedFormat:
' Selected sheets, 1 file per sheet;
' Or a specified From/To group of sheets to 1 file,
' Or selected sheets (random grouping) to 1 file;
' Or an entire workbook to 1 file.
'
' ArgsIn:
' FileType& xlTypePDF (0) or xlTypeXSP (1)
' Filename$ Contains "<path>\<wkbName>" to which each wks.Name is
appended
' Settings Array containing the settings for the export params
' IsGroup !
'
Dim wks As Worksheet, sExt$, sFile$, sTS$
If Application.VERSION < 12 Then Exit Sub

sExt = IIf(FileType = 0, ".pdf", ".xps") '//always
sTS = "_" & Format(Now(), "_dd-mm-yyyy_hh-mm_AMPM") '//always

If Not IsGroup Then '//1 file per sheet
For Each wks In ActiveWindow.SelectedSheets
sFile = Filename & "_" & wks.name & IIf(StampIt, sTS & sExt, sExt)
wks.ExportAsFixedFormat Type:=FileType, Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2), OpenAfterPublish:=Settings(3)
Next 'wks

Else '//multiple sheets per file
sFile = Filename & IIf(StampIt, sTS & sExt, sExt)
If Not IsMissing(FromToRng) Then '//it's a group
If Not LBound(FromToRng) = UBound(FromToRng) Then '//it's From/To
ActiveWorkbook.ExportAsFixedFormat Type:=FileType,
Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2), OpenAfterPublish:=Settings(3), _
From:=FromToRng(0), To:=FromToRng(1)

Else '//it's selected sheets (random grouping)
'ExportAsFixedFormat only works with workbooks/worksheets,
'so copy selected sheets to a new (temp) workbook,
'export it, then discard it.
Application.ScreenUpdating = False '//hide activity
ActiveWindow.SelectedSheets.Copy
With ActiveWorkbook
.ExportAsFixedFormat Type:=FileType, Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2),
OpenAfterPublish:=Settings(3)
.Close SaveChanges:=False
End With 'ActiveWorkbook
Application.ScreenUpdating = True
End If 'Not LBound(FromToRng) = UBound(FromToRng)

Else '//all sheets
ActiveWorkbook.ExportAsFixedFormat Type:=FileType,
Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2), OpenAfterPublish:=Settings(3)
End If 'Not IsMissing(FromToRng)
End If 'Not IsGroup
End Sub 'SaveAs_FixedFormat

Sub Test_SaveAs_FixedFormat()
' Shows the various ways to use the SaveAs_FixedFormat routine.
' How the values passed to it are assembled is up to you!
' This example's focus is on how to prep the args only.

Dim sFile$, rng, vSettings
Const lTypePDF& = 0: Const lTypeXPS& = 1

'ExportAsFixedFormat accepts the following ArgsIn:
' Quality: Standard=0, Minimum=1 (file size)
' IncludeDocProperties: False=0, True=1
' IgnorePrintAreas: False=0, True=1
' OpenAfterPublish: False=0, True=1
'We pass our preferences for these to SaveAs_FixedFormat as a variant
array.
vSettings = Split("0,0,0,0", ",") '//edit to suit


'[Construct the Filename according to output path]
'NOTE: Do not include the filename extension
'when using the ExportAsFixedFormat feature.

'If output to ActiveWorkbook.Path, use
'.....................................
sFile = Split(ActiveWorkbook.FullName, ".")(0)
'Edit workbook ref to suit

'If output to a different path, use
'..................................
'Build sFile in logical steps
sFile = "C:\Users\Garry\Documents\VBA_Stuff\" '//path
'Append the filename as per your requirements
sFile = sFile & Split(ActiveWorkbook.name, ".")(0)
'Edit workbook ref to suit


'[Specifying a range of sheets, or a selected sheets grouping]
'.............................................................
'To Export StartWith/EndWith range of sheets, use
rng = Split("1,2", ",") '//From=rng(0),To=rng(1)
'OR
'To Export a random grouping as selected while pressing 'Ctrl', use
rng = Split("1", ",") '//makes LBound=UBound


'[Exporting scenarios]
'To Export 1 file per selected sheet (random grouping)
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile,
Settings:=vSettings
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile,
Settings:=vSettings


'To Export a From/To range of sheets to 1 file
rng = Split("1,2", ",")
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng


'To Export selected sheets to 1 file (random grouping)
rng = Split("1", ",")
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng


'To Export all sheets to 1 file
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True
End Sub 'Test_SaveAs_FixedFormat

Sub PrintTo_FixedFormat(FileType&, Filename$, Optional NumCopies& = 1,
_
Optional IsGroup As Boolean = False, Optional
FromToRng)
' Prints the following choices via the XPS Document Writer:
' Selected sheets, 1 file per sheet;
' Or a specified From/To range of sheets to 1 file,
' Or selected sheets (random grouping) to 1 file;
' Or an entire workbook to 1 file.
'
' ArgsIn:
' FileType& lTypePDF=0; lTypeXPS=1
' Filename Contains "<path>\<wkbName>"
' NumCopies !
' IsGroup !
'
Dim wks As Worksheet, sExt$, sFile$

'Edit to use your 'actual' port address.
Const sPrinter$ = "Microsoft XPS Document Writer on NE00:"
'To quickly find the port your XPS Document Writer uses,
' - change the printer in the Print dialog and close without
printing;
' - in the VBE Immediate Window type the following, then press
'Enter';
' ?activeprinter
' - reset the printer in the Print dialog to your default!

sExt = IIf(FileType = 0, ".pdf", ".xps")
If Not IsGroup Then '//1 file per sheet
For Each wks In ActiveWindow.SelectedSheets
sFile = Filename & "_" & wks.name & Format(Now(),
"_dd-mm-yyyy_hh-mm_AMPM") & sExt
wks.PrintOut ActivePrinter:=sPrinter, Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
Next 'wks
Else
sFile = Filename & Format(Now(), "_dd-mm-yyyy_hh-mm_AMPM") & sExt
If Not IsMissing(FromToRng) Then '//it's a range
If Not LBound(FromToRng) = UBound(FromToRng) Then
ActiveWorkbook.PrintOut From:=CLng(FromToRng(0)),
To:=CLng(FromToRng(1)), _
ActivePrinter:=sPrinter, Copies:=NumCopies,
PrintToFile:=True, PrToFileName:=sFile
Else '//it's a random grouping
ActiveWindow.SelectedSheets.PrintOut ActivePrinter:=sPrinter, _
Copies:=NumCopies, PrintToFile:=True, PrToFileName:=sFile
End If 'Not LBound(FromToRng) = UBound(FromToRng)
Else
ActiveWorkbook.PrintOut ActivePrinter:=sPrinter,
Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
End If 'Not IsMissing(FromToRng)
End If 'Not IsGroup
End Sub 'PrintTo_FixedFormat

Sub Test_PrintTo_FixedFormat()
' Shows the various ways to use the PrintTo_FixedFormat routine.
' How the values passed to it are assembled is up to you!
' This example's focus is on how to prep the args only.

Dim sFile$, rng
Const lTypePDF& = 0: Const lTypeXPS& = 1

'[Construct the Filename according to output path]
'NOTE: Do not include the filename extension
'when using an XPS Document Writer.

'If output to ActiveWorkbook.Path, use
'.....................................
sFile = Split(ActiveWorkbook.FullName, ".")(0)
'Edit workbook ref to suit

'If output to a different path, use
'..................................
'Build sFile in logical steps
sFile = "C:\Users\Garry\Documents\VBA_Stuff\" '//path
'Append the filename as per your requirements
sFile = sFile & Split(ActiveWorkbook.name, ".")(0)
'Edit workbook ref to suit


'[Specifying a range of sheets, or a selected sheets grouping]
'.............................................................
'To print StartWith/EndWith range of sheets, use
rng = Split("1,2", ",") '//From=rng(0),To=rng(1)
'OR
'To print a random grouping as selected while pressing 'Ctrl', use
rng = Split("1", ",") '//makes LBound=UBound


'[Printing scenarios]
'To print 1 file per selected sheet (random grouping)
PrintTo_FixedFormat FileType:=lTypeXPS, Filename:=sFile
'OR
PrintTo_FixedFormat FileType:=lTypePDF, Filename:=sFile


'To print a From/To range of sheets to 1 file
rng = Split("1,2", ",")
PrintTo_FixedFormat FileType:=lTypeXPS, Filename:=sFile,
IsGroup:=True, FromToRng:=rng
'OR
PrintTo_FixedFormat FileType:=lTypePDF, Filename:=sFile,
IsGroup:=True, FromToRng:=rng


'To print selected sheets to 1 file (random grouping)
rng = Split("1", ",")
PrintTo_FixedFormat FileType:=lTypeXPS, Filename:=sFile,
IsGroup:=True, FromToRng:=rng
'OR
PrintTo_FixedFormat FileType:=lTypePDF, Filename:=sFile,
IsGroup:=True, FromToRng:=rng


'To print all sheets to 1 file
PrintTo_FixedFormat FileType:=lTypeXPS, Filename:=sFile,
IsGroup:=True
'OR
PrintTo_FixedFormat FileType:=lTypePDF, Filename:=sFile,
IsGroup:=True
End Sub 'Test_PrintTo_FixedFormat

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Ad

Advertisements

G

GS

Oops! Looks like I forgot to copy over the PrintTo_FixedFormat routine
to my archive file...


Sub PrintTo_FixedFormat(FileType&, Filename$, _
Optional NumCopies& = 1, _
Optional IsGroup As Boolean = False, _
Optional FromToRng, Optional StampIt As Boolean
= True)
' Prints the following choices via the XPS Document Writer:
' Selected sheets, 1 file per sheet;
' Or a specified From/To range of sheets to 1 file,
' Or selected sheets (random grouping) to 1 file;
' Or an entire workbook to 1 file.
'
' ArgsIn:
' FileType& lTypePDF=0; lTypeXPS=1
' Filename Contains "<path>\<wkbName>"
' NumCopies !
' IsGroup !
'
Dim wks As Worksheet, sExt$, sFile$

'Edit to use your 'actual' port address.
Const sPrinter$ = "Microsoft XPS Document Writer on NE00:"
'To quickly find the port your XPS Document Writer uses,
' - change the printer in the Print dialog and close without
printing;
' - in the VBE Immediate Window type the following, then press
'Enter';
' ?activeprinter
' - reset the printer in the Print dialog to your default!

sExt = IIf(FileType = 0, ".pdf", ".xps")
If Not IsGroup Then '//1 file per sheet
For Each wks In ActiveWindow.SelectedSheets
sFile = Filename & "_" & wks.name & IIf(StampIt, sTS & sExt, sExt)
wks.PrintOut ActivePrinter:=sPrinter, Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
Next 'wks

Else
sFile = Filename & IIf(StampIt, sTS & sExt, sExt)
If Not IsMissing(FromToRng) Then '//it's a range
If Not LBound(FromToRng) = UBound(FromToRng) Then
ActiveWorkbook.PrintOut From:=CLng(FromToRng(0)),
To:=CLng(FromToRng(1)), _
ActivePrinter:=sPrinter, Copies:=NumCopies,
PrintToFile:=True, PrToFileName:=sFile

Else '//it's a random grouping
ActiveWindow.SelectedSheets.PrintOut ActivePrinter:=sPrinter, _
Copies:=NumCopies, PrintToFile:=True, PrToFileName:=sFile
End If 'Not LBound(FromToRng) = UBound(FromToRng)

Else
ActiveWorkbook.PrintOut ActivePrinter:=sPrinter,
Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
End If 'Not IsMissing(FromToRng)
End If 'Not IsGroup
End Sub 'PrintTo_FixedFormat

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top