View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Excel to PDF/XPS boilerplate routines: tweaked

After some sleep, tweaking, and including switch to PDF printer in
PrintTo_FixedFormat, here's my final versions of both routines...

Sub PrintTo_FixedFormat(FileType&, Filename$, _
Optional NumCopies& = 1, Optional FromToRng, _
Optional IsGroup As Boolean = False, _
Optional StampIt As Boolean = True)
' Prints the following choices via XPS Document Writer OR PDF printer,
' as specified by 'FileType':
' 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$, sStamp$
Dim sPrinter$, sDfltPrn$

Const sPrnXPS$ = "Microsoft XPS Document Writer on NE00:"
Const sPrnPDF$ = "deskPDF on DDM:"
'To quickly find the port your 'FileType' printer 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!

'Initialize essential vars
sDfltPrn = Application.ActivePrinter '//reset when done
sPrinter = IIf(FileType = 0, sPrnPDF, sPrnXPS)
sExt = IIf(FileType = 0, ".pdf", ".xps")
sStamp = "_" & Format(Now(), "dd-mm-yyyy_hh-mm_AMPM")

If Not IsGroup Then '//1 file per sheet
For Each wks In ActiveWindow.SelectedSheets
sFile = Filename & "_" & wks.Name & IIf(StampIt, sStamp & sExt,
sExt)
wks.PrintOut ActivePrinter:=sPrinter, Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
Next 'wks
Else
sFile = Filename & IIf(StampIt, sStamp & 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
Application.ActivePrinter = sDfltPrn
End Sub 'PrintTo_FixedFormat


Sub SaveAs_FixedFormat(FileType&, Filename$, _
Settings, Optional FromToRng, _
Optional IsGroup As Boolean = False, _
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

--
Garry

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