View Single Post
  #36   Report Post  
Posted to microsoft.public.excel.programming
GS[_6_] GS[_6_] is offline
external usenet poster
 
Posts: 1,182
Default Excel print object?

At one time, ages ago, the following worked":

ActivePrinter = "Acrobat PDFWriter on FILE:", PrintToFile:= True, _
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=False, _


You could try this if supported...

Sub PrintToFile_XPS(Filename$)
Const sPrinter$ = "Microsoft XPS Document Writer on NE00:" '//edit to actual
port address
ActiveWindow.SelectedSheets.PrintOut _
Copies:=1, ActivePrinter:=sPrinter, _
PrintToFile:=True, PrToFileName:=Filename & ".xps"
End Sub

...or use the FixedFormat feature[s]...

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

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 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 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