Question

我有一个宏，可以在许多工作簿中使用该宏，以按名称将某些选项卡导出为PDF，这是可行的。问题是我需要导出的命名选项卡并不总是以相同的顺序/我想要的顺序显示。下面的代码显示了我要导出为PDF的选项卡的名称，但是excel默认将命名选项卡的导出顺序设置为它们出现的顺序（从左到右）。我想知道你们是否知道如何定义这些工作表在PDF中的显示顺序，而不管它们在我的工作簿中出现的顺序如何？我试图避免使用一个宏，该宏会暂时将我的工作表导出到单独的工作簿中。

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

Answer 1

类似于@ fabio.avigo提到的内容，请像这样修改您发布的例程：

Sub PDFActiveSheet(ByRef wsA As Worksheet)

    ...

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

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

    ...
End Sub

然后创建另一个子，以您想要的任何顺序在工作表中调用它，如下所示：

Public Sub PDFMySheets()
    PDFActiveSheet ThisWorkbook.Sheets("Sheet3")
    PDFActiveSheet ThisWorkbook.Sheets("Sheet2")
    PDFActiveSheet ThisWorkbook.Sheets("Sheet1")
End Sub

Answer 2

将选定的工作表导出为PDF的问题是Excel会将它们保存在单个文件中，但只能按照它们在工作簿中出现的顺序保存。这意味着我们必须将工作表重新排序为所需的顺序。下面的代码使用OP中发布的PDFActiveSheet例程，但是添加了逻辑来对工作表进行重新排序，加上逻辑在我们完成导出后恢复了原始顺序。

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

VBA语法以自定义顺序将某些选项卡导出为PDF

2 个答案: