使用 VBA，将除两个工作表之外的所有工作表合并为一个 PDF

Question

我试图将工作簿中的所有工作表保存为一个 pdf（所有工作表合并在一个 pdf 中），除了 pdf 中不需要的两个工作表，其名称为“Raw”和“Tables”。我有一个代码，但是当我运行它时，即使代码成功运行，我也看不到保存的文件。我做错了什么或者有更简单的方法来解决这个问题吗？谢谢！

Sub CombineWorksheetsAsPDF()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim saveFolderPath As String
    Dim pdfFileName As String
    Dim wsNamesToExclude As String
    Dim wsNamesArray As Variant
    Dim i As Long
    Dim pdfFilePath As String
    saveFolderPath = "C:\Users\j\Documents" ' Change this!!!!!
    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    pdfFileName = Left(wb.Name, InStrRev(wb.Name, ".")) & ".pdf"
    wsNamesToExclude = "Raw,Tables" ''exclude these tabs
    wsNamesArray = Split(wsNamesToExclude, ",")
    pdfFilePath = saveFolderPath & pdfFileName
    If Dir(pdfFilePath) <> "" Then
        Kill pdfFilePath
    End If
    
    For Each ws In wb.Sheets
        If Not IsInArray(ws.Name, wsNamesArray) Then
            ws.Select
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
        End If
    Next ws
    Application.ScreenUpdating = True
    
    MsgBox "PDF seved in: " & saveFolderPath, vbInformation
End Sub

Function IsInArray(ByVal valToBeFound As String, arr As Variant) As Boolean
    Dim element As Variant
    On Error Resume Next
    IsInArray = (UBound(Filter(arr, valToBeFound)) > -1)
    On Error GoTo 0
End Function

Answer 1

将工作表导出为单个 PDF

Sub ExportSheetsToSinglePDF()
    
    Const PROC_TITLE As String = "Export Sheets to Single PDF"
    Const SAVE_PATH As String = "C:\Users\j\Documents"
    Const EXCLUSIONS_LIST As String = "Raw,Tables"
    
    Dim wb As Workbook: Set wb = ActiveWorkbook
    ' if it's the workbook containing this code, use 'ThisWorkbook' instead.
    
    Dim Exclusions() As String: Exclusions = Split(EXCLUSIONS_LIST, ",")
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim sh As Object
    
    For Each sh In wb.Sheets
        If IsError(Application.Match(sh.Name, Exclusions, 0)) Then
            dict(sh.Name) = Empty
        End If
    Next sh
    
    If dict.Count = 0 Then
        MsgBox "No sheets found.", vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    Dim PdfFileName As String:
    PdfFileName = Left(wb.Name, InStrRev(wb.Name, ".")) & "pdf"
    
    Dim pSep As String: pSep = Application.PathSeparator
    
    Dim PdfFilePath As String: PdfFilePath = SAVE_PATH
    If Right(PdfFilePath, 1) <> pSep Then PdfFilePath = PdfFilePath & pSep
    PdfFilePath = PdfFilePath & PdfFileName
    
    wb.Sheets(dict.Keys).Copy
    
    With Workbooks(Workbooks.Count)
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFilePath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        .Close SaveChanges:=False
    End With
    
    Dim Msg As Long:
    
    Msg = MsgBox("Sheets exported to """ & PdfFileName & """ located in """ _
        & SAVE_PATH & """!" & vbLf & vbLf _
        & "Do you want to explore the destination path?", _
        vbQuestion + vbYesNo + vbDefaultButton2, PROC_TITLE)
    If Msg = vbYes Then
        wb.FollowHyperlink SAVE_PATH
    End If
    
End Sub