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

Question

I have some VBA code that successfully copies a range from Excel into slide two of a new presentation based on a template (the VBA opens Powerpoint).

The macro ends by pasting the chart into slide two from a worksheet in Excel. What I want to do now is go back to that worksheet, copy the chart that has already been plotted from that data and paste it into the same slide that the data has just been pasted into.

My Code

'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

I don't know how many charts you have on the source sheet but assuming it's just one, if you add these lines at the end of your code it will copy and paste the first chart from your referenced sheet to your second slide:

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

Note that if the target slide has empty chart and/or object placeholders, the chart can be automatically pasted into a target placeholder if you select it first with something like this:

PPSlide.Shapes.Placeholders(2).Select

Index 2 may need to be changed depending on your slide's layout.

You can then move the chart like this:

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

Answer 2

This is not fully tested (as I don't have Excel 2013), so I can't test AddChart2 , but similar code with Charts work with 2010.

Let me know if you are getting an error on the following line: Set Cht = XLws.Shapes.AddChart2(201, xlColumnClustered).Chart

Code

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

You can use different type of PasteSpecial , just choose the one you prefer :

I've set 2 ways to place the pasted shapes, so that you can set it easily!

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