Paste Excel Chart into Powerpoint using VBA

Question

I'm trying to create an excel macro that copies charts displayed on an excel sheet, and pastes them (paste special) into a PowerPoint. The problem I'm having is how do I paste each chart on a different slide? I do not know the syntax at all..

This is what I have so far (it works but it only pastes to the first sheet):

Sub graphics3()

Sheets("Chart1").Select
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.ChartArea.Copy
Sheets("Graphs").Select
range("A1").Select
ActiveSheet.Paste
     With ActiveChart.Parent
     .Height = 425 ' resize
     .Width = 645  ' resize
     .Top = 1    ' reposition
     .Left = 1   ' reposition
 End With

Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="locationwherepptxis"

Set PPApp = GetObject("Powerpoint.Application")
Set PPPres = PPApp.activepresentation
Set PPSlide = PPPres.slides _
    (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
    Format:=xlPicture

' Paste chart
PPSlide.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

Answer 1

Given I dont have your file locations to work with I have attached a routine below that

1. Created a new instance of PowerPoint (late binding, hence the need to define constants for ppViewSlide etc)
2. Loops through each chart in a sheet called Chart1 (as per your example)
3. Adds a new slide
4. Pastes each chart, then repeats

Did you need to format each chart picture before exporting for size, or can you change your default chart size?

Const ppLayoutBlank = 2
Const ppViewSlide = 1

Sub ExportChartstoPowerPoint()
    Dim PPApp As Object
    Dim chr
    Set PPApp = CreateObject("PowerPoint.Application")
    PPApp.Presentations.Add
    PPApp.ActiveWindow.ViewType = ppViewSlide
    For Each chr In Sheets("Chart1").ChartObjects
        PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
        PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
        chr.Select
        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        PPApp.ActiveWindow.View.Paste
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    Next chr
    PPApp.Visible = True
End Sub