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$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

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$1:$B$16")
    .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，只需选择您喜欢的类型：

我设置了两种放置粘贴形状的方法，以便您可以轻松设置它！

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粘贴范围

3 个答案: