如何使用 vba 将多个图表从 excel 导出到单个 pdf？

How can I export multiple graphs from excel to a single pdf using vba?

提问by sineil

I am completely new to VBA and need to export multiple graphs from an excel workbook to a single pdf using vba. I know it's possible to export the graphs as individual pdf's or jpgs but is it possibly to put all graphs from a workbook into one pdf using vba? Any advice would be greatly appreciated as I can't seem to find what I'm looking for elsewhere.

我是 VBA 的新手，需要使用 vba 将多个图形从 excel 工作簿导出到单个 pdf。我知道可以将图形导出为单独的 pdf 或 jpg，但是是否可以使用 vba 将工作簿中的所有图形放入一个 pdf 中？任何建议将不胜感激，因为我似乎无法在其他地方找到我正在寻找的东西。

My code so far prints each chart to the pdf, but each chart gets overwritten on the next print. My code is as follows:

到目前为止，我的代码将每个图表打印到 pdf，但每个图表在下一次打印时都会被覆盖。我的代码如下：

Sub exportGraphs()
Dim Ws As Worksheet
Dim Filename As String
Filename = Application.InputBox("Enter the pdf file name", Type:=2)
Sheets("Status and SLA trends").Select
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveChart.ExportAsFixedFormat xlTypePDF, Filename, xlQualityStandard
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ExportAsFixedFormat xlTypePDF, Filename, xlQualityStandard

Sheets("Current Issue Status").Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ExportAsFixedFormat xlTypePDF, Filename, xlQualityStandard
ActiveSheet.ChartObjects("Chart 5").Activate
ActiveChart.ExportAsFixedFormat xlTypePDF, Filename, xlQualityStandard
ActiveSheet.ChartObjects("Chart 8").Activate
ActiveChart.ExportAsFixedFormat xlTypePDF, Filename, xlQualityStandard
End Sub

回答by sineil

In the end I just exported an array of sheets to pdf, as multiple charts were on separate sheets and I didn't need to change how they were formatted. I did it using the following code snippet

最后，我只是将一组工作表导出为 pdf，因为多个图表位于不同的工作表上，我不需要更改它们的格式。我使用以下代码片段做到了

Sheets(Array("Current Issue Status", "Status and SLA trends")).Select
Dim saveLocation As String
saveLocation = Application.GetSaveAsFilename( _
fileFilter:="PDF Files (*.pdf), *.pdf")
If saveLocation <> "False" Then
ActiveSheet.ExportAsFixedFormat xlTypePDF, saveLocation, xlQualityStandard
End If

回答by Bex

[Export all charts to one PDF] This worked for me: I extended the sample from here. It copies all charts to a temporary sheet, then changes the page setup (letter /landscape) and resize/re-position each chart to fit separate page borders. Last step is to print this sheet as pdf doc and delete temp sheet.

[将所有图表导出为一个 PDF] 这对我有用：我从这里扩展了示例。它将所有图表复制到临时工作表，然后更改页面设置（字母/横向）并调整每个图表的大小/重新定位以适合单独的页面边框。最后一步是将此表打印为 pdf 文档并删除临时表。

Sub kartinka()
Dim i As Long, j As Long, k As Long
Dim adH As Long
Dim Rng As Range
Dim FilePath As String: FilePath = ThisWorkbook.Path & "\"
Dim sht As Worksheet, shtSource As Worksheet, wk As Worksheet
'===================================================================
'===================================================================
Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "ALL"
Set sht = ActiveSheet
'===================================================================
Application.ScreenUpdating = False
'===================================================================
'Excluding ALL tab, copying all charts from all tabs to ALL
For Each wk In Worksheets
    If wk.Name <> "ALL" Then
        Application.DisplayAlerts = False
            j = wk.ChartObjects.Count
                For i = 1 To j
                    wk.ChartObjects(i).Activate
                    ActiveChart.ChartArea.Copy
                    sht.Select
                    ActiveSheet.Paste
                    sht.Range("A" & 1 + i & "").Select
                 Next i
        Application.DisplayAlerts = True
    End If
Next
'===================================================================
'===================================================================
'To set the constant cell vertical increment for separate pages
adH = 40
k = 0
j = sht.ChartObjects.Count
'===================================================================
Application.PrintCommunication = True 'this will allow page settings to update
'To set page margins, adding some info about the file location, tab name and date
With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Orientation = xlLandscape
        .LeftHeader = "Date generated : " & Now
        .CenterHeader = ""
        .RightHeader = "File name : " & ActiveWorkbook.Name
        .LeftFooter = "File location : " & FilePath & ThisWorkbook.Name
        .CenterFooter = ""
        .RightFooter = ""
        .FitToPagesWide = 1
End With
'===================================================================
'adjusting page layout borders
sht.VPageBreaks.Add sht.[N1]
For i = 40 To j * 40 Step 40
sht.HPageBreaks.Add Before:=sht.Cells(i + 1, 1)
Next i
Columns("A:A").EntireRow.RowHeight = 12.75
Rows("1:1").EntireColumn.ColumnWidth = 8.43
'===================================================================
For i = 1 To j
Set Rng = ActiveSheet.Range("A" & (1 + k * adH) & " :M" & (40 + k * adH) & "")
    With ActiveSheet.ChartObjects(i)
        .Height = Rng.Height
        .Width = Rng.Width
        .Top = Rng.Top
        .Left = Rng.Left
    End With
    ActiveSheet.PageSetup.PrintArea = "$A:$M" & (40 + k * adH) & ""
 k = k + 1
Next i
'===================================================================
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath & ActiveWorkbook.Name & "." & ActiveSheet.Name, Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'===================================================================
Application.DisplayAlerts = False
ThisWorkbook.Sheets("ALL").Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

回答by Siddharth Rout

Is this what you are trying?

这是你正在尝试的吗？

LOGIC: Copy all charts to a Temp Sheet and then use the Excel's inbuilt tool to create the pdf. Once the pdf is made, delete the temp sheet. This will export multiple graphs from Sheets("Status and SLA trends")to a single pdf using vba.

逻辑：将所有图表复制到临时表，然后使用 Excel 的内置工具创建 pdf。制作pdf后，删除临时表。这将Sheets("Status and SLA trends")使用 vba将多个图形导出为单个 pdf。

CODE (TRIED AND TESTED):

代码（久经考验）：

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim chrt As Shape
    Dim tp As Long
    Dim NewFileName As String

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    NewFileName = "C:\Charts.Pdf"

    Set ws = Sheets("Status and SLA trends")
    Set wsTemp = Sheets.Add

    tp = 10

    With wsTemp
        For Each chrt In ws.Shapes
            chrt.Copy
            wsTemp.Range("A1").PasteSpecial
            Selection.Top = tp
            Selection.Left = 5
            tp = tp + Selection.Height + 50
        Next
    End With

    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFileName, Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

    Application.DisplayAlerts = False
    wsTemp.Delete

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