VBA实现多工作簿各工作表单独导出PDF并跳过指定名称工作表

以下为调整完成的可直接运行代码，完全保留原代码的变量定义、交互逻辑、格式兼容规则，仅按需求修改了导出逻辑：

Sub ExcelSaveAsPDF()
    Dim strPath As String
    Dim xStrFile1, xStrFile2 As String
    Dim xWbk As Workbook
    Dim xSFD, xRFD As FileDialog
    Dim xSPath As String
    Dim xRPath, xWBName As String
    Dim xBol As Boolean
    Dim xWsh As Worksheet
    Dim xSkipSheets As Variant
    Dim i As Long
    Dim xBolSkip As Boolean
    
    ' 定义需要跳过的工作表名称列表
    xSkipSheets = Array("pricing", "cover", "important")
    
    Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
    
    With xSFD
        .Title = "Please select the folder contains the Excel files you want to convert:"
        .InitialFileName = "C:\"
    End With
    
    If xSFD.Show <> -1 Then Exit Sub
    
    xSPath = xSFD.SelectedItems.Item(1)
    
    Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
    
    With xRFD
        .Title = "Please select a destination folder to save the converted files:"
        .InitialFileName = "C:\"
    End With
    
    If xRFD.Show <> -1 Then Exit Sub
    
    xRPath = xRFD.SelectedItems.Item(1) & "\"
    strPath = xSPath & "\"
    xStrFile1 = Dir(strPath & "*.*")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Do While xStrFile1 <> ""
        xBol = False
        If Right(xStrFile1, 3) = "xls" Then
            Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
            xBol = True
        ElseIf Right(xStrFile1, 4) = "xlsx" Then
            Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
            xBol = True
        ElseIf Right(xStrFile1, 4) = "xlsm" Then
            Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
            xBol = True
        End If
        
        If xBol Then
            ' 遍历当前工作簿所有工作表
            For Each xWsh In xWbk.Worksheets
                ' 判断当前工作表是否在跳过列表中（默认不区分大小写匹配）
                xBolSkip = False
                For i = LBound(xSkipSheets) To UBound(xSkipSheets)
                    If LCase(xWsh.Name) = xSkipSheets(i) Then
                        xBolSkip = True
                        Exit For
                    End If
                Next i
                ' 非跳过列表内的工作表单独导出为PDF
                If Not xBolSkip Then
                    xWsh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xRPath & xWsh.Name & ".pdf"
                End If
            Next xWsh
            xWbk.Close SaveChanges:=False
        End If
        
        xStrFile1 = Dir
    
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

核心调整说明 #

• 新增工作表遍历逻辑，替换原整工作簿导出规则，实现每个工作表单独生成独立PDF
• 新增工作表名称过滤规则，自动跳过名称为pricing/cover/important的工作表，默认匹配不区分大小写，如需区分大小写可删除判断逻辑中的LCase()函数
• 调整命名规则，导出PDF文件名直接取对应工作表的名称，符合发票附件命名要求
• 修正了原代码中源文件夹选择弹窗标题的字符串断行语法错误

运行提示：如果不同工作簿中存在同名工作表，后导出的文件会覆盖路径下的同名PDF，如有防覆盖需求可在文件名拼接逻辑中增加原工作簿名称作为前缀。

内容的提问来源于stack exchange，提问作者Daniel Holmkvist