点击按钮导出后缀为_graph的Excel工作表为PDF时提示未找到对应表

问题描述 #

尝试将所有后缀为_graph的Excel工作表导出为PDF，但运行VBA代码时弹出错误提示：No sheets with suffix '_graph' found.，已确认存在名为level1_graph的目标工作表。

原代码 #

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim PrintFile As String
    Dim GraphSheets As Collection
    Dim sheetName As String
    Dim i As Integer

    PrintFile = "C:\Users\Desktop\level_graph.pdf"
    Set GraphSheets = New Collection

    ' Loop through all worksheets and collect sheets with suffix "_graph"
    On Error Resume Next
    For Each ws In ThisWorkbook.Worksheets
        If Right(ws.Name, 6) = "_graph" Then
            GraphSheets.Add ws.Name
        End If
    Next ws
    On Error GoTo 0 ' Turn back on error handling

    ' Check if there are any sheets found
    If GraphSheets.Count > 0 Then
        ' Select the sheets to print
        For i = 1 To GraphSheets.Count
            Sheets(GraphSheets(i)).Select (i = 1)
        Next i

        ' Export the selected sheets as PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=PrintFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    Else
        MsgBox "No sheets with suffix '_graph' found.", vbExclamation
    End If
End Sub

问题分析 #

1. ThisWorkbook指向错误 #

如果代码存储在非目标工作簿（比如个人宏工作簿）中，ThisWorkbook会指向代码所在的工作簿，而非包含level1_graph的目标工作簿，导致遍历范围错误。

2. 后缀匹配逻辑不可靠 #

Right(ws.Name,6)依赖固定字符数匹配，若工作表名称存在隐藏字符（如末尾空格、制表符），或字符数计算错误，会导致匹配失败。

3. On Error Resume Next掩盖潜在错误 #

整个循环启用错误忽略，可能掩盖集合添加时的异常（如重复名称、权限问题），导致符合条件的工作表未被加入集合。

修正方案 #

以下是优化后的代码，解决了上述问题：

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim PrintFile As String
    Dim GraphSheets As Collection
    Dim i As Integer

    ' 动态获取用户桌面路径，避免硬编码错误
    PrintFile = Environ("USERPROFILE") & "\Desktop\level_graph.pdf"
    Set GraphSheets = New Collection

    ' 遍历当前活动工作簿的工作表（若目标工作簿固定，可改为Workbooks("你的工作簿名.xlsx")）
    For Each ws In ActiveWorkbook.Worksheets
        ' 更可靠的后缀匹配：查找最后一个下划线，判断后续字符是否为graph
        If InStrRev(ws.Name, "_") > 0 Then
            If LCase(Mid(ws.Name, InStrRev(ws.Name, "_") + 1)) = "graph" Then
                ' 用Key避免重复添加，仅临时启用错误捕获
                On Error Resume Next
                GraphSheets.Add ws.Name, Key:=ws.Name
                On Error GoTo 0
            End If
        End If
    Next ws

    ' 导出PDF逻辑
    If GraphSheets.Count > 0 Then
        ' 直接选择集合中的工作表，简化循环
        ActiveWorkbook.Sheets(GraphSheets).Select
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=PrintFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    Else
        MsgBox "No sheets with suffix '_graph' found.", vbExclamation
    End If
End Sub

关键修正点 #

• 修正工作簿指向：将ThisWorkbook改为ActiveWorkbook，确保遍历目标工作簿的工作表；若目标工作簿固定，可直接指定工作簿名称。
• 优化后缀匹配：使用InStrRev查找最后一个下划线，结合Mid提取后缀，并用LCase忽略大小写，避免隐藏字符或字符数计算错误导致的匹配失败。
• 合理处理错误：仅在添加集合元素时临时启用错误捕获，避免掩盖整个循环的异常。
• 路径优化：用Environ("USERPROFILE")动态获取用户桌面路径，避免硬编码路径的兼容性问题。

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