如何使用宏将具有不同数据系列的同一图的多个版本保存为 pdf？

Question

我想将具有不同数据集的同一图的多个版本保存为单个 pdf。现在，我的代码根据用户为特定数据集输入“y”，将每个图单独保存到单独的文件夹（在本例中为图表）。用户可能想要绘制 100 多个图表，因此我不想复制并制作一张新工作表，并为每个图表绘制一个图表。

如果有解决方案，我也可以使用 Bluebeam 插件，但我对该插件非常不熟悉。

Sub NewChartDataRewrite()
Dim LastFigRow As Long
Dim FigRangeName As String
 FigRangeName = ("I3:I")
 LastFigRow = FindLastRow()

Dim FigYes As Range
Set FigYes = Worksheets("Bulk Calc").Range(FigRangeName & LastFigRow)

    For Each cell In FigYes

        If UCase(cell.Value) = "Y" Then

'Saves charts as indiviual PDFs
            Dim NewPath As String
            Dim NewFolder As String
            Dim ActivePath As String
        
            ActivePath = ActiveWorkbook.Path
            NewPath = ActivePath & "\Charts\"
            NewFolder = Dir(NewPath, vbDirectory)
            
            If NewFolder = "" Then
            MkDir NewPath
            End If
            
            Dim SaveNameString As String
            SaveNameString = Sheets("Bulk Calc").Range("'Bulk Calc'!$L$" & cell.Row).Value
  
            Sheets("Chart (0)").Select
            ActiveChart.ChartArea.Select
            
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewPath & SaveNameString _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
        End If
    Next
End Sub



Function FindLastRow() As Long
 
    Sheets("Bulk NIC").Select
    Cells(2, 1).Select
 

    FindLastRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
                    

End Function

如前所述，我可以单独保存具有不同数据的绘图，但希望为每个新绘图构建一个 pdf，以拥有一个包含 100 多个页面的 pdf，而不是包含 100 多个单独的 pdf 的单个页面。

Answer 1

这是一个简单的示例，使用单个图表和带有“复制为图片”的循环将所有图表编译到单个工作表上：

Sub ChartLoop()
    Dim ws As Worksheet, cht As Chart, rw As Range, posTop As Long
    Dim wsOut As Worksheet
    Set ws = Worksheets("Data")
    Set wsOut = Worksheets("Charts")
    
    Set cht = ws.ChartObjects(1).Chart
    
    posTop = 5
    For Each rw In ws.Range("A2:E15").Rows    'loop over source Y values
        cht.SeriesCollection(1).Values = rw   'adjust chart data
        cht.CopyPicture                       'copy...
        wsOut.Paste
        With wsOut.Shapes(wsOut.Shapes.Count) 'adjust the pasted chart image
            .Left = 5
            .Top = posTop
            posTop = posTop + .Height + 5     'next top position
        End With
    Next rw
End Sub