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

问题

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.

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

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

回答1:

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

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

回答2:

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.

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

回答3:

[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.

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$1:$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

来源：https://stackoverflow.com/questions/10497713/how-can-i-export-multiple-graphs-from-excel-to-a-single-pdf-using-vba