vbaを使用して複数のグラフをExcelから単一のpdfにエクスポートするにはどうすればよいですか？

Question

私はVBAを全く新しくしており、Excelブックから複数のグラフをvbaを使って1つのpdfにエクスポートする必要があります。グラフを個別のpdfまたはjpgとしてエクスポートすることは可能ですが、ワークブックのすべてのグラフをvbaを使用して1つのpdfに入れることは可能でしょうか？私が他の所で探しているものを見つけることができないように思われるので、アドバイスをいただければ幸いです。

これまでのコードでは、各グラフがpdfに印刷されていますが、各グラフは次の印刷時に上書きされます。私のコードは次の通りです：

Answer 1

エンドで複数のグラフを別々のシートにあったと私はどのように変更する必要はありませんでしたように私はただ、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 

Answer 2

これはあなたの試みですか？

LOGIC：すべてのチャートを一時シートにコピーし、Excelの組み込みツールを使用してPDFを作成します。 pdfが作成されたら、一時シートを削除します。これにより、複数のグラフがSheets("Status and SLA trends")からvbaを使用して1つのpdfにエクスポートされます。

CODE（実証済み）：

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 

Answer 3

次のコードスニペットを使用してそれをしなかった。これは私のために働いた[1つのPDFにすべてのチャートをエクスポート]：私はhereからサンプルを拡張しました。すべてのチャートを一時的なシートにコピーし、ページ設定（文字/風景）を変更し、各チャートを別々のページ境界に合わせてサイズ変更/再配置します。最後のステップは、このシートを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