如何通过Excel单元格值在VBA中更新PDF导出的工作表列表

直接上修改后的代码，核心是把硬编码的工作表数组换成从指定单元格区域读取的动态列表，同时从选中工作表A1获取导出路径：

Sub ExportSheetsToPDF()
    Dim wsList As Worksheet
    Dim exportSheets As Variant
    Dim sheetNames As Collection
    Dim cell As Range
    Dim targetPath As String
    Dim ws As Worksheet
    Dim i As Integer
    
    ' 指定存储工作表列表的工作表
    Set wsList = ThisWorkbook.Sheets("Figures")
    
    ' 初始化集合存储有效工作表名称
    Set sheetNames = New Collection
    
    ' 遍历A4:A78区域，提取非空且存在的工作表名称
    On Error Resume Next
    For Each cell In wsList.Range("A4:A78")
        If cell.Value <> "" Then
            ' 检查工作表是否存在，避免报错
            Set ws = ThisWorkbook.Sheets(CStr(cell.Value))
            If Not ws Is Nothing Then
                ' 排除Figures工作表本身
                If ws.Name <> wsList.Name Then
                    sheetNames.Add ws.Name
                End If
                Set ws = Nothing
            End If
        End If
    Next cell
    On Error GoTo 0
    
    ' 如果没有有效工作表，提示并退出
    If sheetNames.Count = 0 Then
        MsgBox "未找到可导出的有效工作表，请检查Figures工作表的A4:A78区域", vbExclamation
        Exit Sub
    End If
    
    ' 将集合转换为数组，适配ExportAsFixedFormat要求
    ReDim exportSheets(1 To sheetNames.Count)
    For i = 1 To sheetNames.Count
        exportSheets(i) = sheetNames(i)
    Next i
    
    ' 获取选中工作表A1的目标文件夹路径
    If ActiveSheet Is Nothing Then
        MsgBox "请先选中存储路径的工作表", vbExclamation
        Exit Sub
    End If
    targetPath = ActiveSheet.Range("A1").Value
    
    ' 检查路径是否有效，末尾补斜杠
    If targetPath = "" Then
        MsgBox "目标路径不能为空，请在选中工作表的A1单元格填写路径", vbExclamation
        Exit Sub
    End If
    If Right(targetPath, 1) <> "\" Then targetPath = targetPath & "\"
    
    ' 执行导出
    On Error Resume Next
    ThisWorkbook.Sheets(exportSheets).Select
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=targetPath & "导出文件.pdf", ' 可自定义文件名
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False ' 设为True导出后自动打开PDF
    On Error GoTo 0
    
    ' 取消选中状态，恢复原工作表激活
    ThisWorkbook.Sheets(1).Select
    
    MsgBox "PDF导出完成，路径：" & targetPath & "导出文件.pdf", vbInformation
End Sub

关键修改点说明： #

• 动态读取工作表列表：遍历Figures!A4:A78，自动过滤空值、不存在的工作表，同时排除Figures本身
• 路径获取：从当前选中工作表的A1单元格读取目标文件夹，自动补全末尾斜杠避免路径错误
• 错误处理：添加了空列表、空路径、工作表不存在的提示，避免代码崩溃
• 兼容性：把集合转成数组，适配ExportAsFixedFormat要求的参数格式

使用注意： #

1. 在Figures工作表的A4到A78填写需要导出的工作表编号（比如"4""5"），空行会自动忽略
2. 选中存储路径的工作表，确保A1单元格填写正确的文件夹路径（比如C:\Users\XXX\Documents\）
3. 可自行修改代码中的导出文件名（"导出文件.pdf"部分）
4. 如果需要导出后自动打开PDF，把OpenAfterPublish:=False改成True

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