It has been drilled into my head, to avoid bugs and provide a good user experience, it is best to avoid using
Keeping this in mind, is there a way to use the
.ExportAsFixedFormat method on a subset of
Sheets in a workbook without employing one of the above? So far the only ways I have been able to come up with to do this are to either:
- use a
For Each; however, this results in separate PDF files, which is no good.
use the code similar to that generated by the macro recorder, which uses
Sheets(Array("Sheet1", "Chart1", "Sheet2", "Chart2")).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "exported file.pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= True
Perhaps it is impossible not to use
ActiveSheet, but can I at least get around using
I have tried this:
Sheets(Array("Sheet1", "Chart1", "Sheet2","Chart2")).ExportAsFixedFormatType:= _ xlTypePDF, Filename:= "exported file.pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= _ True
error 438: Object doesn’t support this property or method
Hate to dredge up an old question, but I’d hate to see somebody stumbling across this question resort to the code gymnastics in the other answers. The
ExportAsFixedFormat method only exports visible Worksheets and Charts. This is much cleaner, safer, and easier:
Sub Sample() ToggleVisible False ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ "exported file.pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True ToggleVisible True End Sub Private Sub ToggleVisible(state As Boolean) Dim ws As Object For Each ws In ThisWorkbook.Sheets Select Case ws.Name Case "Sheet1", "Chart1", "Sheet2", "Chart2" Case Else ws.Visible = state End Select Next ws End Sub
It has been drilled into my head (through lots of….
I know what do you MEAN 😉
Here is one way which doesn’t use
- Delete the unnecessary sheets
- Export the entire workbook.
- Close the workbook without saving so that you get your deleted sheets back
Sub Sample() Dim ws As Object On Error GoTo Whoa '<~~ Required as we will work with events '~~> Required so that deleted sheets/charts don't give you Ref# errors Application.Calculation = xlCalculationManual For Each ws In ThisWorkbook.Sheets Select Case ws.Name Case "Sheet1", "Chart1", "Sheet2", "Chart2" Case Else Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End Select Next ws '~~> Use ThisWorkbook instead of ActiveSheet ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "exported file.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, openafterpublish:=True LetsContinue: Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True '~~> VERY IMPORTANT! This ensures that you get your deleted sheets back. ThisWorkbook.Close SaveChanges:=False Exit Sub Whoa: MsgBox Err.Description Resume LetsContinue End Sub
EDIT: Happy to report that the now current accepted answer has made this idea entirely unnecessary.
Thanks to Siddharth Rout for providing me with the idea for a way to do this!
EDIT: As written below this module mostly works but not entirely; the problem I am having is the charts do not keep their data after the sheets they refer to have been deleted (this is despite the inclusion of the
pApp.Calculation = xlCalculationManual command). I haven’t been able to figure out how to fix this. Will update when I do.
Below is a class module (implementing the methodology of this answer) to solve this problem. Hopefully it will be useful for someone, or people could offer feedback on it if it doesn’t work for them.
'**********WorkingWorkbook Class*********' 'Written By: Rick Teachey ' 'Creates a "working copy" of the desired ' 'workbook to be used for any number of ' 'disparate tasks. The working copy is ' 'destroyed once the class object goes out' 'of scope. The original workbook is not ' 'affected in any way whatsoever (well, I ' 'hope, anyway!) ' '''''''''''''''''''''''''''''''''''''''''' Option Explicit Private pApp As Excel.Application Private pWorkBook As Workbook Private pFullName As String Property Get Book() As Workbook Set Book = pWorkBook End Property Public Sub Init(CurrentWorkbook As Workbook) Application.DisplayAlerts = False Dim NewName As String NewName = CurrentWorkbook.FullName 'Append _1 onto the file name for the new (temporary) file Do NewName = Mid(NewName, 1, InStr(Len(NewName) - 4, NewName, ".") - 1) _ & Replace(NewName, ".", "_1.", Len(NewName) - 4, 1) 'Check if the file already exists; if so, append _1 again Loop While (Len(Dir(NewName)) <> 0) 'Save the working copy file CurrentWorkbook.SaveCopyAs NewName 'Open the working copy file in the background pApp.Workbooks.Open NewName 'Set class members Set pWorkBook = pApp.Workbooks(Dir(NewName)) pFullName = pWorkBook.FullName Application.DisplayAlerts = True End Sub Private Sub Class_Initialize() 'Do all the work in the background Set pApp = New Excel.Application 'This is the default anyway so probably unnecessary pApp.Visible = False 'Could probably do without this? Well just in case... pApp.DisplayAlerts = False 'Workaround to prevent the manual calculation line from causing an error pApp.Workbooks.Add 'Prevent anything in the working copy from being recalculated when opened pApp.Calculation = xlCalculationManual 'Also probably unncessary, but just in case pApp.CalculateBeforeSave = False 'Two more unnecessary steps, but it makes me feel good Set pWorkBook = Nothing pFullName = "" End Sub Private Sub Class_Terminate() 'Close the working copy (if it is still open) If Not pWorkBook Is Nothing Then On Error Resume Next pWorkBook.Close savechanges:=False On Error GoTo 0 Set pWorkBook = Nothing End If 'Destroy the working copy on the disk (if it is there) If Len(Dir(pFullName)) <> 0 Then Kill pFullName End If 'Quit the background Excel process and tidy up (if needed) If Not pApp Is Nothing Then pApp.Quit Set pApp = Nothing End If End Sub
Sub test() Dim wwb As WorkingWorkbook Set wwb = New WorkingWorkbook Call wwb.Init(ActiveWorkbook) Dim wb As Workbook Set wb = wwb.Book Debug.Print wb.FullName End Sub
An option, without creating a new WB:
Option Explicit Sub fnSheetArrayPrintToPDF() Dim strFolderPath As String Dim strSheetNamesList As String Dim varArray() As Variant Dim bytSheet As Byte Dim strPDFFileName As String Dim strCharSep As String strCharSep = "," strPDFFileName = "SheetsPrinted" strSheetNamesList = ActiveSheet.Range("A1") If Trim(strSheetNamesList) = "" Then MsgBox "Sheet list is empty. Check it. > ActiveSheet.Range(''A1'')" GoTo lblExit End If For bytSheet = 0 To UBound(Split(strSheetNamesList, strCharSep, , vbTextCompare)) ReDim Preserve varArray(bytSheet) varArray(bytSheet) = Trim(Split(strSheetNamesList, strCharSep, , vbTextCompare)(bytSheet)) Next strFolderPath = Environ("USERPROFILE") & "\Desktop\pdf\" On Error Resume Next MkDir strFolderPath On Error GoTo 0 If Dir(strFolderPath, vbDirectory) = "" Then MsgBox "Err attempting to create the folder: '" & strFolderPath & "'." GoTo lblExit End If Sheets(varArray).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFolderPath & strPDFFileName, _ OpenAfterPublish:=False, IgnorePrintAreas:=False MsgBox "Print success." & vbNewLine & " Folder: " & strFolderPath, vbExclamation, "Printing to PDF" lblExit: Exit Sub End Sub