Print Multiple Sheets to PDF using VBA

Question

I'm trying to print to pdf using vba. However, when using the below sub I get an error subscript out of range. Could someone please let me know how to fix. Much appreciated.

Sub Print_Int()

ThisWorkbook.Worksheets(Array("Sheet16", "Sheet10")).ExportAsFixedFormat Type:=xlTypePDF

End Sub

Answer 1

The error means that the workbook running the code does not contain one or both of the specified sheets.

Also, ThisWorkbook.Worksheets(Array("Sheet16", "Sheet10")) returns a Sheets object. However, ExportAsFixedFormat requires a Worksheet object.

And you're missing the filename for the second argument (unless it's intentional). Try the following instead...

Sub Print_Int()

    With ThisWorkbook
    
        .Activate
    
        .Worksheets(Array("Sheet16", "Sheet10")).Select
    
        .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="c:\users\username\desktop\sample.pdf" 'change the path and filename accordingly
    
    End With
    
End Sub

Answer 2

Export to PDF: Enforce 'Chosen' Order

• When exporting multiple sheets to a single PDF, the sheets are exported using the order of the tabs (10, 16) ignoring the order in the array of sheet names (16, 10).
• The following enforces the order in the array (16, 10). It detects if the order is different and moves each sheet after the last one, starting with the first sheet that is out of order. After exporting, it moves them back to their initial positions.
• It finally selects the initially selected sheet in the workbook containing this code.
• Not nearly enough tested!

Sub Print_Int()

    Const FILE_PATH As String = "C:\Test\Test.pdf"
    Dim SheetNames() As Variant:
    SheetNames = VBA.Array("Sheet16", "Sheet10")

    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    wb.Activate
    Dim ash As Object: Set ash = wb.ActiveSheet
    
    Dim iUpper As Long: iUpper = UBound(SheetNames)
    Dim SheetIndices() As Variant: ReDim SheetIndices(0 To iUpper)
    
    Dim i As Long, MaxIndex As Long, FirstIndex As Long
    Dim IsFirstFound As Boolean, MoveSheets As Boolean
    
    For i = 0 To iUpper
        If IsFirstFound Then
            SheetIndices(i) = wb.Sheets(SheetNames(i)).Index
            If Not MoveSheets Then
                If SheetIndices(i) < MaxIndex Then
                    MoveSheets = True
                    FirstIndex = i
                End If
            End If
        Else
            SheetIndices(0) = wb.Sheets(SheetNames(0)).Index
            MaxIndex = SheetIndices(0)
            IsFirstFound = True
        End If
    Next i
    
    If MoveSheets Then
        For i = FirstIndex To iUpper
            SheetIndices(i) = wb.Sheets(SheetNames(i)).Index - 1
            wb.Sheets(SheetNames(i)).Move After:=wb.Sheets(wb.Sheets.Count)
        Next i
    End If
    
    wb.Sheets(SheetNames).Select
    wb.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=FILE_PATH, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    If MoveSheets Then
        For i = iUpper To FirstIndex Step -1
            If SheetIndices(i) = 0 Then
                wb.Sheets(SheetNames(i)).Move Before:=wb.Sheets(1)
            Else
                wb.Sheets(SheetNames(i)).Move After:=wb.Sheets(SheetIndices(i))
            End If
        Next i
    End If
    
    ash.Select
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheets exported:" & vbLf & vbLf & Join(SheetNames, vbLf), _
        vbInformation
    
End Sub