将 Excel 图表粘贴到 Powerpoint 中刚刚在使用 VBA 中粘贴了一个范围

Question

我有一些 VBA 代码可以成功地将 Excel 的范围复制到基于模板的新演示文稿的第二张幻灯片中（VBA 打开 Powerpoint）。

宏最后将图表粘贴到 Excel 中工作表的第二张幻灯片中。我现在要做的是返回到该工作表，复制已经从该数据绘制的图表并将其粘贴到刚刚粘贴数据的同一张幻灯片中。

我的代码

'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:$B")
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

我不知道您在源代码中有多少图表 sheet 但假设只有一个，如果您在代码末尾添加这些行，它将复制并粘贴您的第一个图表sheet 引用了你的第二张幻灯片：

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

请注意，如果目标幻灯片有空图表 and/or 对象占位符，则图表可以自动粘贴到目标占位符中，前提是您先 select 使用如下内容：

PPSlide.Shapes.Placeholders(2).Select

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

然后您可以像这样移动图表：

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

Answer 2

这还没有经过全面测试（因为我没有 Excel 2013），所以我无法测试 AddChart2，但是与图表类似的代码适用于 2010。

如果您在以下行中遇到错误，请告诉我： Set Cht = XLws.Shapes.AddChart2(201, xlColumnClustered).Chart

代码

Option Explicit

Sub ExportToPPT()

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

Dim XLws As Worksheet
Dim Cht As Chart

Set XLws = ActiveSheet

'Plots Chart Based on Tabular Data
XLws.Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Select

Set Cht = XLws.Shapes.AddChart2(201, xlColumnClustered).Chart

With Cht
    .ApplyChartTemplate ("C:\Users\Colin\AppData\Roaming\Microsoft\Templates\Charts\Edge45 Bar Chart Transparent Horizontal Bars.crtx")
    .SetSourceData Source:=Range("'Screaming Frog Summary'!$A:$B")
    .Shapes("Chart 1").IncrementLeft -57.6
    .Shapes("Chart 1").IncrementTop 243.9
End With

'Opens a new PowerPoint presentation based on template and pastes data into Slide 2 of Powerpoint from Excel
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

Cht.ChartArea.Copy '<-- copy the Chart
Set PPChart = PPSlide.Shapes.PasteSpecial(ppPasteDefault, msoFalse) 'ppPasteShape


End Sub

Answer 3

您可以使用不同类型的 PasteSpecial，只需选择您喜欢的类型即可：

我设置了2种粘贴形状的放置方式，方便你设置！

Sub test_Superhans()
    Dim PPApp As PowerPoint.Application, PPPres As PowerPoint.Presentation, PPSlide As PowerPoint.Slide, PPShape As Object
    Dim wS As Excel.Worksheet, Rg As Excel.Range, oCh As Object

    'Opens a new PowerPoint presentation based on template
    Set PPApp = New PowerPoint.Application
        PPApp.Visible = True
    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)
    Set PPSlide = PPPres.Slides(2)

    'Set the sheet where the data is
    Set wS = ThisWorkbook.Sheets("Screaming Frog Summary")
    With wS
        Set Rg = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
        Set oCh = .Shapes.AddChart2(201, xlColumnClustered)
    End With 'wS

    With oCh
        .ApplyChartTemplate ( _
            "C:\Users\Colin\AppData\Roaming\Microsoft\Templates\Charts\Edge45 Bar Chart Transparent Horizontal Bars.crtx")
        .SetSourceData Source:=Rg
        .Copy
    End With 'oCh

    'Paste and place the chart
    ''Possibles DataType : see the image! ;)
    Set PPShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile, Link:=msoFalse)
    Application.CutCopyMode = False
    With PPShape
        .Height = 100
        'Place from bottom using : PPPres.PageSetup.SlideHeigth - .Height
        .Top = PPPres.PageSetup.SlideHeigth - .Height - 10
        .Width = 100
        'Place from right using : PPPres.PageSetup.SlideWidth - .Width
        .Left = PPPres.PageSetup.SlideWidth - .Width - 10
    End With

    'Copy the data
    Rg.Copy
    Set PPShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse)
    Application.CutCopyMode = False
    With PPShape
        .Height = 100
        'Place from top
        .Top = 10
        .Width = 100
        'Place from left
        .Left = 10
    End With
End Sub

将 Excel 图表粘贴到 Powerpoint 中刚刚在使用 VBA 中粘贴了一个范围

Paste Excel Chart into Powerpoint having just pasted a range in using VBA

excel

powerpoint

vba