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

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或jpgs,但是是否可以使用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

3 个解决方案

#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

最后,我只是将一系列工作表导出为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

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

LOGIC:将所有图表复制到Temp Sheet,然后使用Excel的内置工具创建pdf。完成pdf后,删除临时表。这将使用vba将表格中的多个图表(“状态和SLA趋势”)导出为单个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

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

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

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