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:

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

Quite possible to merge pdf files using a Python library, https://www.blog.pythonlibrary.org/2018/04/11/splitting-and-merging-pdfs-with-python/ and to call a Python library from VBA you need a gateway class like this example https://exceldevelopmentplatform.blogspot.com/2018/06/vba-python-using-python-to-read-text.html — S Meaden, Dec 26 '18 at 02:54

score 32 · Accepted Answer · answered Mar 19 '16 at 21:42

32

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

answered Mar 19 '16 at 21:42

Comintern

21,855
5
33
80

1

Oh my god SO MUCH EASIER! Thank you. – Rick Mar 21 '16 at 20:52
My problem with this solution is that I already have some hidden sheets. When I run this code the are toggled to visible again. Is there a way around this? – user8837495 Feb 02 '21 at 16:18
Great and simple solution! Thank you. I have some other solution but your is simple and workable (Excel 2010)! – Isma Feb 18 '21 at 10:15
If the workbook has some hidden sheets before this is actioned, you would want to record the hidden state of each worksheet. The easiest way would be to create a dictionary to hold the hidden state as each worksheet name would be unique, ([VBA-Dictionary](https://excelmacromastery.com/vba-dictionary/)) then loop over it as necessary. – Tragamor Mar 11 '22 at 10:38

score 14 · Answer 2 · edited May 23 '17 at 12:26

14

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:

Delete the unnecessary sheets
Export the entire workbook.
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

edited May 23 '17 at 12:26

Community

1
1

answered Apr 01 '14 at 20:54

Siddharth Rout

147,039
17
206
250

Krikey! That works! It's of course kind of kludgey, but in my (short) VBA career it has become apparent that such solutions are often unavoidable. Thanks a heap. – Rick Apr 01 '14 at 21:05
1

good workaround , but it seems to me that in this particular case using Select/Active would be much better:) – Dmitry Pavliv Apr 01 '14 at 21:09
@simoco yes it would be but then you will have to take lot of precautions. For example, fully qualifying the objects so that they don't refer to the wrong workbook etc etc.. to avoid all those runtime errors... – Siddharth Rout Apr 01 '14 at 21:11
2

Also one note, removing sheets may break formulas and you'd get a lot of `#REF!` in pdf – Dmitry Pavliv Apr 01 '14 at 21:31
sorry, yeah:) you're right! my fault, didn't noticed it:) – Dmitry Pavliv Apr 01 '14 at 21:35
I wonder if there's an elegant way (by that I suppose I just mean it is invisible to the user) to make a working copy of the original workbook, perform the action using the working copy, and then just delete the working copy. I might fiddel with that at little tomorrow morning. – Rick Apr 02 '14 at 03:44
@RickTeachey: Not sure about the `elegant` way but yes, you can create a copy using [SaveCopyAs Method](http://msdn.microsoft.com/en-us/library/office/ff835014%28v=office.15%29.aspx) – Siddharth Rout Apr 02 '14 at 06:37

Rick · Answer 3 · 2017-09-25T15:07:55.123

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

score 0 · Answer 4 · answered Nov 22 '18 at 20:37

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

Export multiple sheets to PDF simultaneously without using ActiveSheet or Select

4 Answers4

WorkingWorkbook.cls

Testing Procedure

Linked