如何用宏将同一图表的多版本（不同数据系列）保存为单PDF

方案思路 #

不用生成大量单页PDF再合并，而是用一个临时工作表批量承载所有需要导出的图表，最后一次性导出该工作表为单PDF文件，避免重复创建工作表的麻烦。

修改后的完整代码 #

Sub NewChartDataRewrite_CombinePDF()
    Dim LastFigRow As Long
    Dim FigRangeName As String
    Dim FigYes As Range
    Dim cell As Range
    Dim NewPath As String
    Dim TempSheet As Worksheet
    Dim NextRow As Long
    
    ' 初始化路径和临时工作表
    FigRangeName = "I3:I"
    LastFigRow = FindLastRow()
    Set FigYes = Worksheets("Bulk Calc").Range(FigRangeName & LastFigRow)
    
    ActivePath = ActiveWorkbook.Path
    NewPath = ActivePath & "\Charts\"
    If Dir(NewPath, vbDirectory) = "" Then MkDir NewPath
    
    ' 创建临时工作表
    On Error Resume Next
    Set TempSheet = ThisWorkbook.Worksheets("TempChartSheet")
    If Err.Number <> 0 Then
        Set TempSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        TempSheet.Name = "TempChartSheet"
    End If
    On Error GoTo 0
    TempSheet.Cells.Clear ' 清空临时表内容
    
    NextRow = 1 ' 临时表中放置图表的起始行
    
    ' 遍历标记为Y的行，生成并复制图表到临时表
    For Each cell In FigYes
        If UCase(cell.Value) = "Y" Then
            ' 获取图表对应命名（用于PDF整体命名参考）
            SaveNameString = Sheets("Bulk Calc").Range("$L$" & cell.Row).Value
            
            ' 激活目标图表工作表（确保图表已对应当前行数据更新）
            Sheets("Chart (0)").Activate
            
            ' 复制图表到临时表
            ActiveChart.ChartArea.Copy
            TempSheet.Range("A" & NextRow).PasteSpecial Paste:=xlPasteAll
            
            ' 调整下一个图表的位置，避免重叠（可根据图表大小修改行间距）
            NextRow = NextRow + 30
            
        End If
    Next cell
    
    ' 导出临时表为单个PDF
    TempSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=NewPath & "Combined_Charts.pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    ' 可选：删除临时工作表，避免文件冗余
    Application.DisplayAlerts = False
    TempSheet.Delete
    Application.DisplayAlerts = True
    
    MsgBox "合并PDF已生成，路径：" & NewPath & "Combined_Charts.pdf"
End Sub

Function FindLastRow() As Long
    FindLastRow = Sheets("Bulk NIC").Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
End Function

关键说明 #

• 临时工作表：创建一个临时表统一存放所有图表，导出完成后可自动删除，不破坏原文件结构。
• 图表间距调整：NextRow = NextRow + 30 控制图表间的垂直间距，可根据你的实际图表高度修改数值，确保图表不重叠。
• 数据更新前提：需确保原逻辑中Sheets("Chart (0)")的图表会随遍历行自动更新对应数据，如果原代码未实现这一步，需要补充数据关联的代码。

Bluebeam插件替代方案（快速操作） #

如果想用Bluebeam合并已生成的单页PDF：

1. 打开Bluebeam Revu，点击文件 > 合并
2. 选中Charts文件夹下所有目标PDF文件，调整排序顺序
3. 设置合并后的保存路径和文件名，点击合并完成操作

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