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

我有一些VBA代码，它根据VBA打开Powerpoint的模板，成功地将Excel中的一系列内容复制到新演示文稿的第二张幻灯片中

宏结束时，将图表粘贴到Excel工作表的幻灯片2中。我现在要做的是回到工作表，复制已经从数据中绘制的图表，并将其粘贴到数据刚刚粘贴到的同一张幻灯片中

我的代码

---

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

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

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

PPSlide.Shapes.Placeholders(2).Select

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

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

然后可以按如下方式移动图表：

PPSlide.Shapes.Placeholders(2).Select

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

---

由于我没有Excel 2013，所以我无法测试AddChart2，但类似的图表代码也适用于2010

如果您在以下行中遇到错误，请告诉我： 设置Cht=XLws.Shapes.AddChart2201，xlColumnClustered.Chart

代码

---

您可以使用不同类型的特殊粘贴，只需选择您喜欢的一种：

我已经设置了两种放置粘贴形状的方法，以便您可以轻松地进行设置

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

---

您可以简单地将数据表添加到图形中，单击图形，进入顶部菜单，添加元素，数据表，选择；谢谢-但这并不能解决我的问题-我需要将图表单独粘贴到数据中。@Superhans你在使用Excel 2013吗？不，使用Excel 2016try www.pptxbuilder.com