Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I print an object in Excel 2007 | Excel Discussion (Misc queries) | |||
Print Word Object in Excel | Excel Discussion (Misc queries) | |||
Why does a pasted object in Excel sometimes print upside down? | Excel Discussion (Misc queries) | |||
Print more then one page in excel from a word object | Excel Worksheet Functions |