如何将Excel所有图表导出为无截断的单PDF（2x2横向带标题）

以下是针对需求修改后的VBA代码，实现每页先显示指定单元格文本作为标题，再以2x2横向布局展示4个图表，且保证图表不会被截断：

Sub ExportChartsToPDF()
    Dim s As Workbook
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim chrt As ChartObject
    Dim tp As Long, ts As Long
    Dim chartCount As Integer
    Dim titleText As String
    Dim SourcePath As String, File As String, NewFileName As String
    
    ' 关闭Excel提示和屏幕刷新，提升运行速度
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ' 路径和文件设置
    SourcePath = "\\ukfs1\users\gabriem\Documents\Misproyectos\BigPromotions\QAPromo"
    File = "graphicator.xlsx"
    NewFileName = "\\ukfs1\users\gabriem\Documents\Mis proyectos\BigPromotions\QAPromo\test_pdf.pdf"
    
    ' 打开目标工作簿并指定工作表
    Set s = Workbooks.Open(SourcePath & "\" & File)
    Set ws = s.Sheets("Negocios")
    ' 获取标题文本（这里假设标题在ws的A1单元格，可根据实际修改）
    titleText = ws.Range("A1").Value
    
    ' 创建临时工作表
    Set wsTemp = s.Sheets.Add
    With wsTemp
        ' 设置页面为横向，调整边距适配图表布局
        .PageSetup.Orientation = xlLandscape
        .PageSetup.TopMargin = Application.InchesToPoints(0.5)
        .PageSetup.BottomMargin = Application.InchesToPoints(0.5)
        .PageSetup.LeftMargin = Application.InchesToPoints(0.5)
        .PageSetup.RightMargin = Application.InchesToPoints(0.5)
        .PageSetup.HeaderMargin = Application.InchesToPoints(0.25)
        .PageSetup.FooterMargin = Application.InchesToPoints(0.25)
    End With
    
    ' 初始化变量：tp=纵向位置，ts=横向位置，chartCount=图表计数
    tp = 20 ' 标题下方的起始纵向位置
    ts = 20 ' 起始横向位置
    chartCount = 0
    
    ' 插入第一页标题
    With wsTemp.Range("A1")
        .Value = titleText
        .Font.Size = 14
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .EntireRow.AutoFit
    End With
    
    ' 遍历所有图表并按2x2布局排列
    For Each chrt In ws.ChartObjects
        chartCount = chartCount + 1
        
        ' 复制图表到临时工作表
        chrt.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wsTemp.Paste
        
        ' 调整粘贴后的图表位置和大小（统一尺寸避免错位）
        With wsTemp.Shapes(wsTemp.Shapes.Count)
            .Top = tp
            .Left = ts
            ' 设置统一的图表大小，适配2x2布局（可根据实际调整）
            .Width = (wsTemp.PageSetup.PrintArea.Width - 60) / 2
            .Height = (wsTemp.PageSetup.PrintArea.Height - 80) / 2
        End With
        
        ' 控制布局：每行2个图表，每2行（4个图表）换页
        Select Case chartCount Mod 4
            Case 1, 3 ' 第1、3个图表，横向移到右侧
                ts = ts + wsTemp.Shapes(wsTemp.Shapes.Count).Width + 20
            Case 2 ' 第2个图表，换行到左侧，纵向下移
                ts = 20
                tp = tp + wsTemp.Shapes(wsTemp.Shapes.Count).Height + 20
            Case 0 ' 第4个图表，插入分页符，重置位置并添加新标题
                wsTemp.Rows(tp + wsTemp.Shapes(wsTemp.Shapes.Count).Height + 20).Insert
                wsTemp.HPageBreaks.Add Before:=wsTemp.Rows(tp + wsTemp.Shapes(wsTemp.Shapes.Count).Height + 20)
                tp = 20
                ts = 20
                ' 插入新页标题
                With wsTemp.Cells(wsTemp.HPageBreaks(wsTemp.HPageBreaks.Count).Location.Row - 1, 1)
                    .Value = titleText
                    .Font.Size = 14
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                    .EntireRow.AutoFit
                End With
        End Select
    Next chrt
    
    ' 导出临时工作表为PDF
    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFileName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    ' 删除临时工作表，恢复Excel设置
    wsTemp.Delete
    s.Close SaveChanges:=False ' 关闭源工作簿不保存

LetsContinue:
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

关键修改说明 #

• 标题设置：从源工作表的A1单元格获取标题文本，每页顶部居中显示，可根据实际修改ws.Range("A1")的位置
• 2x2布局控制：通过chartCount计数器判断图表位置，每行2个、每列2个，满4个自动插入分页符并添加新标题
• 图表尺寸统一：强制设置图表宽度和高度，适配打印区域，避免因原始图表尺寸不一导致布局混乱
• 页面优化：设置横向页面、缩小边距，确保4个图表+标题能完整显示在一页内，不会被截断
• 错误处理：保留原有的错误捕获逻辑，同时优化临时工作表和源工作簿的清理流程

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