2

私はVBAにまったく慣れていないので、vbaを使用してExcelワークブックから単一のPDFに複数のグラフをエクスポートする必要があります。グラフを個別のpdfまたはjpgとしてエクスポートすることは可能ですが、vbaを使用してワークブックのすべてのグラフを1つの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
4

3 に答える 3

3

複数のグラフが別々のシートにあり、フォーマット方法を変更する必要がなかったため、最終的にはシートの配列を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
于 2012-05-10T11:45:28.433 に答える
2

これはあなたがしようとしていることですか？

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

コード（試行およびテスト済み）：

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
于 2012-05-08T15:52:03.107 に答える
2

[すべてのグラフを1つの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
于 2017-10-15T19:04:25.417 に答える