vba를 사용하여 여러 개의 그래프를 Excel에서 단일 PDF로 내보내려면 어떻게해야합니까?

Question

나는 VBA에 완전히 익숙하지 않아 Excel 통합 문서에서 여러 개의 그래프를 vba를 사용하여 하나의 pdf로 내보낼 필요가 있습니다. 개별 PDF 또는 jpg로 그래프를 내보낼 수는 있지만 통합 문서의 모든 그래프를 vba를 사용하여 하나의 pdf로 변환 할 수 있습니까? 내가 다른 곳에서 찾고있는 것을 찾을 수없는 것처럼 어떤 충고도 크게 감사 할 것입니다.

내 코드는 각 차트를 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 

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를 사용하여 하나의 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

이 나를 위해 일 [하나의 PDF에 대한 모든 차트를 내보내기] 다음 코드를 스 니펫을 사용하여 한 : 나는 here에서 샘플을 확장했다. 모든 차트를 임시 시트에 복사 한 다음 페이지 설정 (글자/가로)을 변경하고 각 차트를 개별 페이지 경계에 맞게 크기를 조정/재배치합니다. 마지막 단계는이 시트를 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$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