按条件将Excel工作表批量导出为单PDF文件报错求助

直接触发报错的核心问题 #

你的代码中判断A1单元格是否符合条件的逻辑存在错误：

If LCase(ws.Range("A1").Value) = "Print" Then

你将A1的值转为小写后，却和大写开头的"Print"做比对，两者永远不相等，导致sheetsInPDF始终为0，直接进入「PDF file not created」的分支。

修正后的完整代码 #

Sub Save_Sheets_As_PDF()
    Dim sheetsInPDF As Long
    Dim ws As Worksheet
    Dim PDFfileName As String
    Dim selectedSheets As New Collection ' 用集合存储符合条件的工作表
    
    With ThisWorkbook
        sheetsInPDF = 0
        ' 遍历所有工作表，收集符合条件的项
        For Each ws In .Worksheets
            ' 支持A1单元格包含"Print"关键词的判断（不区分大小写）
            If InStr(LCase(ws.Range("A1").Value), "print") > 0 Then
                selectedSheets.Add ws
                sheetsInPDF = sheetsInPDF + 1
            End If
        Next
        
        If sheetsInPDF > 0 Then
            PDFfileName = .Worksheets("QUOTE").Range("B6").Value & ".pdf"
            ' 将集合转为数组，批量导出所有符合条件的工作表
            Dim sheetArr() As String
            ReDim sheetArr(1 To selectedSheets.Count)
            Dim i As Integer
            For i = 1 To selectedSheets.Count
                sheetArr(i) = selectedSheets(i).Name
            Next
            
            .Sheets(sheetArr).ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=PDFfileName, _
                Quality:=xlQualityMinimum, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
                
            MsgBox "已创建 '" & PDFfileName & "'，包含 " & sheetsInPDF & " 个工作表"
        Else
            MsgBox "未创建PDF文件（未找到符合条件的工作表）"
        End If
        
        ' 恢复选中第一个工作表
        .Worksheets(1).Select
    End With
End Sub

额外优化说明 #

1. 如果你的需求是A1单元格必须精确等于"Print"，而非包含关键词，可将判断逻辑改回：

If LCase(ws.Range("A1").Value) = "print" Then

2. 改用集合存储符合条件的工作表，再转数组批量导出，比原代码的Select操作更稳定，避免选中操作引发的意外问题。
3. 给Worksheets("QUOTE")添加了.前缀，确保引用当前工作簿的工作表，避免跨工作簿引用错误。

内容的提问来源于stack exchange，提问作者Brad Morgan