如何修改VBA代码实现单份多页PDF导出 而非生成多份独立PDF文件

实现思路 #

原有代码是在循环中对每个符合条件的区域单独执行导出操作，自然会生成多份独立PDF。要实现合并导出需求，调整逻辑如下：

• 保留原有的区域筛选逻辑，先收集所有标记为Include的目标区域
• 新增临时工作表作为导出载体，将所有目标区域按顺序复制到临时表，每复制完成一个区域就插入分页符，确保每个区域单独占用一页
• 所有区域复制完成后，统一将临时工作表导出为单份PDF，最后删除临时表还原工作簿初始状态

修改后完整代码 #

Sub ExpPdf_Merge()
  Dim sh As Worksheet, lastR As Long, rng As Range, arr, arrSplit, i As Long, k As Long
  
  Set sh = Sheet17
  lastR = sh.Range("C" & sh.Rows.Count).End(xlUp).Row
  
  ' 收集所有标记为Include的目标区域
  ReDim arr(lastR - 1)
  For i = 6 To lastR
        If sh.Range("E" & i).Value = "Include" Then
            arr(k) = sh.Range("C" & i).Value & "|" & sh.Range("D" & i).Value: k = k + 1
        End If
  Next i
  If k > 0 Then
        ReDim Preserve arr(k - 1)
  Else
        MsgBox "未找到包含""Include""的有效区域，程序退出"
        Exit Sub
  End If
  
  Dim boolHide As Boolean, boolProt As Boolean
  ActiveWorkbook.Unprotect "4321"
  
  ' 创建临时工作表作为合并导出载体
  Dim tempSh As Worksheet, pasteRow As Long
  Set tempSh = ThisWorkbook.Worksheets.Add
  pasteRow = 1 ' 临时表起始粘贴行
  
  For i = 0 To UBound(arr)
        boolHide = False: boolProt = False
        arrSplit = Split(arr(i), "|")
        Set rng = Worksheets(arrSplit(0)).Range(arrSplit(1))
        
        ' 解除目标表保护/显示，执行后还原
        If ActiveWorkbook.Sheets(arrSplit(0)).ProtectContents Then _
                ActiveWorkbook.Sheets(arrSplit(0)).Unprotect "4321": boolProt = True
        If ActiveWorkbook.Sheets(arrSplit(0)).Visible <> xlSheetVisible Then _
                ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetVisible: boolHide = True
        
        ' 复制目标区域到临时表
        rng.Copy Destination:=tempSh.Cells(pasteRow, 1)
        ' 插入分页符，保证下一个区域单独占一页
        tempSh.HPageBreaks.Add Before:=tempSh.Cells(pasteRow + rng.Rows.Count, 1)
        pasteRow = pasteRow + rng.Rows.Count
        
        ' 还原目标表状态
        If boolHide Then ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetHidden
        If boolProt Then ActiveWorkbook.Sheets(arrSplit(0)).Protect "4321"
  Next
  
  ' 统一导出合并后的PDF
  Dim saveLocation As String
  saveLocation = ThisWorkbook.Path & "\合并导出.pdf"
  tempSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    saveLocation, Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=True
  
  ' 删除临时工作表
  Application.DisplayAlerts = False
  tempSh.Delete
  Application.DisplayAlerts = True
  
  ActiveWorkbook.Protect "4321"
End Sub

注意事项 #

• 导出的PDF默认保存在工作簿同级目录，文件名为合并导出.pdf，可自行修改saveLocation变量中的文件名和存储路径
• 临时工作表全程后台处理，不会修改原有工作表的内容、保护状态和显隐设置
• 若需要调整页面边距、纸张大小等打印参数，可在导出前添加tempSh.PageSetup相关配置项，适配实际打印需求

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