將Excel圖表粘貼到剛粘貼了使用VBA的范圍的Powerpoint中

Question

我有一些VBA代碼，可以成功地將一個范圍從Excel復制到基於模板的新演示文稿的幻燈片2中（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 ，但是Charts的類似代碼可與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 ，只需選擇您喜歡的一種即可：

我設置了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