0

I have a macro that I can use in many workbooks to export certain tabs by name to a PDF, which works. The problem is the named tabs which I need to export are not always in the same order/my desired order. My code below shows the names of the tabs which I am exporting to PDF, but excel defaults the export order of named tabs to the order in which they appear(from left to right). I was wondering if any of you know how I could define the order which these sheets appear in the PDF no matter what order they appear in my workbook? I am trying to avoid a macro that would export my sheets to a separate workbook temporarily to do this.

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
 wbA.Activate
wbA.Sheets(Array(wbA.Sheets(2).Name, wbA.Sheets(3).Name)).Select

**------------------------------ THis is where I imagine the code would go**
 ActiveSheet.ExportAsFixedFormat _
   Type:=xlTypePDF, Filename:=myFile, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, 
 OpenAfterPublish:=False
 'confirmation message with file info
  MsgBox "PDF file has been created: " _
  & vbCrLf _
   & myFile
  End If

  exitHandler:
  Exit Sub
 errHandler:
 MsgBox "Could not create PDF file"
 Resume exitHandler
 End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
matt
  • 1
  • 2
  • 2
    How about creating a sub that stores your sheets order, changes it to the desired order, exports the PDF and finally changes it back to the original order? – fabio.avigo Oct 08 '18 at 17:26
  • Probably, this is duplicate of https://stackoverflow.com/questions/29061072/print-multiple-excel-sheets-in-a-specific-order – serges_newj Oct 08 '18 at 17:59
  • And also of this https://stackoverflow.com/questions/13804102/exporting-multiple-pages-to-pdf-in-a-specific-order – serges_newj Oct 08 '18 at 18:04

2 Answers2

0

Similar to what @fabio.avigo mentioned, modify the routine you posted like this:

Sub PDFActiveSheet(ByRef wsA As Worksheet)

    ...

    '--- comment out this line
    'Dim wsA As Worksheet

    '--- and this one
    'Set wsA = ActiveSheet

    ...
End Sub

Then create another sub to call it with your worksheets in any order you want, like this:

Public Sub PDFMySheets()
    PDFActiveSheet ThisWorkbook.Sheets("Sheet3")
    PDFActiveSheet ThisWorkbook.Sheets("Sheet2")
    PDFActiveSheet ThisWorkbook.Sheets("Sheet1")
End Sub
PeterT
  • 8,232
  • 1
  • 17
  • 38
  • this will not work as it will create 3 *separate* pdf files. The OP wants 2 or more tabs in the same PDF file in a specified order. – Scott Holtzman Oct 08 '18 at 20:24
  • You're absolutely right. I've posted another answer that should work to provide the requested solution. – PeterT Oct 09 '18 at 17:39
0

The problem with exporting selected worksheets to a PDF is that Excel will save them in a single file, but only in the order they appear in the workbook. This means we'll have to re-order the worksheets to the desired order. The code below uses the PDFActiveSheet routine as posted in the OP, but adds logic to re-order the worksheets PLUS logic to restore the original order when we're done with the export.

Option Explicit

Public Sub SaveThem()
    SaveSheetsToPDF "Sheet3", "Sheet1", "Sheet2"
End Sub

Private Sub SaveSheetsToPDF(ParamArray args())
    '--- inputs to this sub are the Worksheet names to save to a single
    '    PDF file, in the order given. Excel will save multiple
    '    worksheets to a single PDF, but only in the order they exist
    '    in the workbook. So we'll have to re-order them.
    Dim i As Long
    Dim ws As Worksheet
    Dim thisWB As Workbook
    Set thisWB = ThisWorkbook

    '--- initial error checking
    If UBound(args, 1) = -1 Then
        MsgBox "SaveSheetsToPDF called with no arguments!", _
               vbCritical + vbOKOnly
        Exit Sub
    Else
        '--- make sure the sheets exist before proceeding
        For i = LBound(args, 1) To UBound(args, 1)
            On Error Resume Next
            Set ws = thisWB.Sheets(args(i))
            If ws Is Nothing Then
                MsgBox "SaveSheetsToPDF called with an invalid sheet name!", _
                       vbCritical + vbOKOnly
                Exit Sub
            End If
            On Error GoTo 0
        Next i
    End If

    '--- save the existing worksheet order
    Dim numberOfWorksheetsInBook As Long
    numberOfWorksheetsInBook = thisWB.Sheets.Count

    Dim sheetsInOrder() As String
    ReDim sheetsInOrder(1 To numberOfWorksheetsInBook)
    For i = 1 To numberOfWorksheetsInBook
        sheetsInOrder(i) = thisWB.Sheets(i).name
        Debug.Print i & " = " & sheetsInOrder(i)
    Next i

    '--- move the given worksheets in the requested order after all the
    '    other worksheets
    With thisWB
        For i = LBound(args, 1) To UBound(args, 1)
            .Sheets(args(i)).Move After:=.Sheets(numberOfWorksheetsInBook)
        Next i
    End With

    '--- now save those worksheets to a PDF file
    thisWB.Sheets(args).Select
    PDFActiveSheet

    '--- restore the original order to the sheets
    Dim sheetName As Variant
    With thisWB
        For Each sheetName In sheetsInOrder
            .Sheets(sheetName).Move Before:=.Sheets(1)
        Next sheetName
    End With
End Sub

Sub PDFActiveSheet()
    'www.contextures.com
    'for Excel 2010 and later
    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strTime As String
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String
    Dim myFile As Variant
    On Error GoTo errHandler

    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    strTime = Format(Now(), "yyyymmdd\_hhmm")

    'get active workbook folder, if saved
    strPath = wbA.path
    If strPath = "" Then
        strPath = Application.DefaultFilePath
    End If
    strPath = strPath & "\"

    'replace spaces and periods in sheet name
    strName = Replace(wsA.name, " ", "")
    strName = Replace(strName, ".", "_")

    'create default name for savng file
    strFile = strName & "_" & strTime & ".pdf"
    strPathFile = strPath & strFile

    'use can enter name and
    ' select folder for file
    myFile = Application.GetSaveAsFilename(InitialFileName:=strPathFile, _
                                           FileFilter:="PDF Files (*.pdf), *.pdf", _
                                           Title:="Select Folder and FileName to save")

    'export to PDF if a folder was selected
    If myFile <> "False" Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:=myFile, _
                                        Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=False, _
                                        OpenAfterPublish:=False
        'confirmation message with file info
        MsgBox "PDF file has been created: " _
             & vbCrLf _
             & myFile
    End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
PeterT
  • 8,232
  • 1
  • 17
  • 38