使用VBA将Excel图表粘贴到Powerpoint中

Question

我的代码

'Plots Chart Based on Tabular Data
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.ApplyChartTemplate ( _
        "C:\Users\Colin\AppData\Roaming\Microsoft\Templates\Charts\Edge45 Bar Chart Transparent Horizontal Bars.crtx")
ActiveChart.SetSourceData Source:=Range("'Screaming Frog Summary'!$A$1:$B$16")
ActiveSheet.Shapes("Chart 1").IncrementLeft -57.6
ActiveSheet.Shapes("Chart 1").IncrementTop 243.9

'Opens a new PowerPoint presentation based on template and pastes data into Slide 2 of Powerpoint from Excel

Dim PPApp As PowerPoint.Application, PPPres As PowerPoint.Presentation, PPSlide As PowerPoint.Slide, PPShape As Object
Dim XLws As Worksheet

Set XLws = ActiveSheet
Set PPApp = New PowerPoint.Application
Set PPPres = PPApp.Presentations.Open("C:\Users\Colin\Dropbox (Edge45)\Edge45 Team Folder\Edge45 Company Documents\Templates\Powerpoint Templates\Edge45 Audit Template Macro.potm", Untitled:=msoTrue)
PPApp.Visible = True
Set PPSlide = PPPres.Slides(2)

XLws.Range("A1:D16").Copy
Set PPShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse)
Application.CutCopyMode = False

With PPShape
    .Top = 10
    .Height = 100
    .Left = 10
    .Width = 100
End With

Answer 1

我不知道源工作表上有多少张图表，但假设只有一张，如果在代码末尾添加这些行，它将从引用工作表复制并粘贴第一张图表到第二张幻灯片：

XLws.ChartObjects(1).Copy ' or XLws.ChartObjects("Chart 1").Copy
Set PPChart = PPSlide.Shapes.PasteSpecial (ppPasteDefault)

请注意，如果目标幻灯片有空的图表和/或对象占位符，则如果您首先使用如下所示选择该图表，则该图表可以自动粘贴到目标占位符中：

PPSlide.Shapes.Placeholders(2).Select

根据幻灯片的布局，可能需要更改索引2。

With PPChart
    .Top = 10
    .Height = 100
    .Left = 10
    .Width = 100
End With