Excel-Diagramm in Powerpoint einfügen, indem Sie einfach einen Bereich eingefügt haben VBA

Question

Ich habe VBA-Code, der erfolgreich einen Bereich von Excel in Folie zwei einer neuen Präsentation basierend auf einer Vorlage kopiert (der VBA öffnet Powerpoint).

Das Makro endet durch Einfügen des Diagramms in Folie zwei aus einem Arbeitsblatt in Excel. Ich möchte jetzt zu diesem Arbeitsblatt zurückkehren, das Diagramm, das bereits geplottet wurde, aus diesen Daten kopieren und es in dieselbe Folie einfügen, in die die Daten gerade eingefügt wurden.

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

Ich weiß nicht, wie viele Diagramme Sie auf dem Quell Blatt haben, aber es ist nur eine Annahme, wenn Sie diese Zeilen am Ende des Codes hinzufügen, wird es kopieren und fügen Sie den ersten Diagramm von Ihrem referenzierten Blatt zu Ihrem zweiten Schlitten:

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

Beachten Sie, dass, wenn das Ziel Schlitten leer Diagramm und/oder Objekt Platzhalter hat, kann das Diagramm automatisch in ein Ziel Platzhalter eingefügt werden, wenn Sie es zuerst auswählen mit etwas wie diesem:

PPSlide.Shapes.Placeholders(2).Select 

Index 2 muss möglicherweise je nach Layout Ihrer Folie geändert werden.

Anschließend können Sie das Diagramm wie folgt bewegen:

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

Answer 2

Dies ist nicht vollständig getestet (wie ich Excel 2013 nicht), so kann ich AddChart2 nicht testen, aber einen ähnlichen Code mit Arbeit Charts mit 2010

Lassen Sie mich wissen, wenn Sie einen Fehler in der folgenden Zeile erhalten: 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

können Sie verschiedene Arten von PasteSpecial verwenden, wählen Sie einfach die Sie bevorzugen:

I 2 Arten festgelegt haben die eingefügten Formen zu platzieren, so dass Sie es leicht einstellen können!

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