如何用Excel VBA将工作表两个指定区域导出为合并多页PDF？

方法一：设置原工作表打印区域与分页符 #

无需额外创建工作表，直接在原工作表中配置打印区域和分页符，确保两个目标区域各占一页后导出。

Sub ExportTwoAreasAsPDF()
    Dim ws As Worksheet
    Dim originalPrintArea As String
    Dim fileName As String
    
    ' 定义目标工作表和文件名
    Set ws = Sheet1 ' 替换为你的目标工作表
    fileName = ws.Range("Z8") & " " & Sheet8.Range("AC11") & ".pdf" ' 沿用原文件名规则
    
    ' 保存原打印区域，避免修改后影响后续使用
    originalPrintArea = ws.PageSetup.PrintArea
    
    On Error GoTo Cleanup ' 出错时自动恢复原设置
    
    ' 设置打印区域为两个目标区域
    ws.PageSetup.PrintArea = "$C$7:$T$70,$C$71:$T$120"
    
    ' 在两个区域之间插入分页符，强制第二区域单独占一页
    ws.Rows(71).PageBreak = xlPageBreakManual
    
    ' 导出为PDF
    ws.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=fileName, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
        
Cleanup:
    ' 恢复原打印区域和分页符设置
    ws.PageSetup.PrintArea = originalPrintArea
    ws.Rows(71).PageBreak = xlPageBreakNone
    Set ws = Nothing
End Sub

方法二：临时创建工作表复制区域后导出 #

若不想修改原工作表的打印设置，可临时创建工作表复制目标区域，导出后自动删除临时表。

Sub ExportTwoAreasViaTempSheets()
    Dim wsSource As Worksheet
    Dim wsTemp1 As Worksheet, wsTemp2 As Worksheet
    Dim fileName As String
    
    ' 定义源工作表和文件名
    Set wsSource = Sheet1
    fileName = wsSource.Range("Z8") & " " & Sheet8.Range("AC11") & ".pdf"
    
    ' 创建临时工作表
    Set wsTemp1 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Set wsTemp2 = ThisWorkbook.Sheets.Add(After:=wsTemp1)
    
    On Error GoTo Cleanup ' 出错时自动删除临时表
    
    ' 复制第一个区域到临时表1，保留格式和内容
    wsSource.Range("C7:T70").Copy
    wsTemp1.Range("A1").PasteSpecial Paste:=xlPasteAll
    wsTemp1.PageSetup.PrintArea = wsTemp1.UsedRange.Address
    
    ' 复制第二个区域到临时表2
    wsSource.Range("C71:T120").Copy
    wsTemp2.Range("A1").PasteSpecial Paste:=xlPasteAll
    wsTemp2.PageSetup.PrintArea = wsTemp2.UsedRange.Address
    
    ' 导出两个临时表为单个PDF
    ThisWorkbook.Sheets(Array(wsTemp1.Name, wsTemp2.Name)).ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=fileName, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
        
Cleanup:
    ' 删除临时工作表，取消删除提示
    Application.DisplayAlerts = False
    wsTemp1.Delete
    wsTemp2.Delete
    Application.DisplayAlerts = True
    Set wsSource = Nothing
    Set wsTemp1 = Nothing
    Set wsTemp2 = Nothing
End Sub

注意事项 #

• 方法一中，确认Rows(71)是两个区域的分界行，分页符会强制从该行开始新页面。
• 方法二中，若只需保留数值而非格式，可将xlPasteAll替换为xlPasteValues。

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