Excel VBA多工作表指定命名范围批量导出为单个PDF问题求助

你之前的写法只能导出当前工作表的单个范围，原因是ActiveSheet.Range仅指向当前激活工作表的范围，且单工作表导出方法无法自动合并多工作表内容。下述方案通过先为每个目标范围所属工作表设置临时打印区域，再批量导出选中工作表集合的方式，实现多个跨表范围合并输出为同一个PDF。

Sub 多工作表指定范围合并导出PDF()
    Dim printRngStr As String, rngArr As Variant
    Dim i As Long, tempSht As Worksheet
    Dim shtNameArr() As String, shtCount As Long
    Dim originalPrintAreaArr() As String ' 存储原有打印区域用于恢复
    Dim PDFFile As String, OpenPDFAfterCreating As Boolean
    
    ' ---------------------- 配置参数自行修改 ----------------------
    PDFFile = "C:\导出结果.pdf" ' 替换为你的PDF保存路径
    OpenPDFAfterCreating = True ' 导出后是否打开PDF
    ' PRINTBOX中多个范围的分隔符，如果你用的是其他符号请修改
    Const RANGE_SPLIT_CHAR As String = ","
    ' ------------------------------------------------------------
    
    ' 读取PRINTBOX内容并拆分范围
    printRngStr = ThisWorkbook.Names("PRINTBOX").RefersToRange.Value
    If Trim(printRngStr) = "" Then Exit Sub
    rngArr = Split(printRngStr, RANGE_SPLIT_CHAR)
    ReDim shtNameArr(0 To UBound(rngArr))
    ReDim originalPrintAreaArr(0 To UBound(rngArr))
    
    ' 遍历所有目标范围，设置对应工作表打印区域
    For i = 0 To UBound(rngArr)
        Dim tempRng As Range
        On Error Resume Next
        Set tempRng = Range(Trim(rngArr(i)))
        On Error GoTo 0
        If Not tempRng Is Nothing Then
            Set tempSht = tempRng.Parent
            ' 存储原有打印区域
            originalPrintAreaArr(shtCount) = tempSht.PageSetup.PrintArea
            ' 设置临时打印区域为目标范围
            tempSht.PageSetup.PrintArea = tempRng.Address
            ' 记录工作表名称
            shtNameArr(shtCount) = tempSht.Name
            shtCount = shtCount + 1
            Set tempRng = Nothing
        End If
    Next i
    
    If shtCount = 0 Then Exit Sub
    ReDim Preserve shtNameArr(0 To shtCount - 1)
    ReDim Preserve originalPrintAreaArr(0 To shtCount - 1)
    
    ' 选中所有目标工作表批量导出PDF
    Sheets(shtNameArr).Select
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=PDFFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=OpenPDFAfterCreating
    
    ' 恢复所有工作表原有打印区域
    For i = 0 To shtCount - 1
        On Error Resume Next
        Sheets(shtNameArr(i)).PageSetup.PrintArea = originalPrintAreaArr(i)
        On Error GoTo 0
    Next i
    
    ' 取消多表选中状态，回到原工作表
    ActiveSheet.Select
End Sub

• 如果PRINTBOX中多个范围的分隔符不是英文逗号，请修改代码中RANGE_SPLIT_CHAR常量的取值为你实际使用的分隔符
• 如果使用工作表级别的命名范围，需要在PRINTBOX中写入完整的带工作表前缀的范围标识，例如Sheet2!销售数据范围
• 导出PDF的页面顺序和PRINTBOX中范围的顺序保持一致，如果需要调整顺序直接修改PRINTBOX内的范围顺序即可

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