Export multiple sheets to PDF simultaneously without using ActiveSheet or Select

Question

It has been drilled into my head, to avoid bugs and provide a good user experience, it is best to avoid using .Select, .Activate, ActiveSheet,ActiveCell, etc.

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:

1. use a For Each; however, this results in separate PDF files, which is no good.

2. use the code similar to that generated by the macro recorder, which uses .Select and ActiveSheet:

   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 .Select somehow?

I have tried this:

Sheets(Array("Sheet1", "Chart1", "Sheet2","Chart2")).ExportAsFixedFormatType:= _
    xlTypePDF, Filename:= "exported file.pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= _
    True

This produces:

error 438: Object doesn't support this property or method

Answer 1

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

Answer 2

It has been drilled into my head (through lots of....

I know what do you MEAN ;)

Here is one way which doesn't use .Select/.Activate/ActiveSheet

Logic:

1. Delete the unnecessary sheets
2. Export the entire workbook.
3. Close the workbook without saving so that you get your deleted sheets back

Code:

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

Answer 3

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

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

Testing Procedure

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

Answer 4

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