Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Print Multiple Sheets to PDF using VBA

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
like image 323
Juli44 Avatar asked Dec 01 '25 16:12

Juli44


1 Answers

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
like image 172
VBasic2008 Avatar answered Dec 03 '25 06:12

VBasic2008



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!