Copying Excel charts To Powerpoint via VBA

[LucasLondon]

Hi,

I have the code below that I found on the web that copies all charts in a given worksheets into PowerPoint onto SEPARATE slides. However, Instead of pasting each chart to one slide, I'd like to paste all charts (four) from the sheet onto ONE slide. Would it be easy to adapt the code below to do this? Ideally I want each chart to take up each corner on the slide, but this is not necessary, it's ok if they overlap (or are on top of each other) as I can adjust them manually.

Thanks,

Lucas

Sub ChartsToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim ppApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer

' Reference existing instance of PowerPoint
Set ppApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = ppApp.ActivePresentation
ppApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set ppSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideIndex
With ppSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With

Next

' Clean up
Set ppSlide = Nothing
Set PPPres = Nothing
Set ppApp = Nothing

End Sub

[Bob Phillips]

Sub ChartsToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim ppApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim aryLeft

aryLeft = Array(100, 200, 300) '<<<<<<<< adjust to fit

' Reference existing instance of PowerPoint
Set ppApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = ppApp.ActivePresentation
ppApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set ppSlide = PPPres.Slides(1)
With ppSlide
' paste and select the chart picture
Set ppShape = .Shapes.Paste
ppShape.Left = aryLeft(iCht - 1)
ppShape.Align msoAlignMiddles, True
End With

Next

' Clean up
Set ppShape = Nothing
Set ppSlide = Nothing
Set PPPres = Nothing
Set ppApp = Nothing

End Sub

[LucasLondon]

XLD,

Thanks for the code. I notice that it only pastes the charts to the very first slide of the Powerpoint presentation. Is that any way to get it to paste the slides to the active slide (the one I have selected) in the presentation rather than the first slide? A major problem with the current set up is I have more than one excel sheet of charts that I need to paste into different slides but currently the procedure pastes all into the same first slide.

Thanks,

Lucas

[Bob Phillips]

Sub ChartsToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim ppApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim aryLeft

aryLeft = Array(100, 200, 300) '<<<<<<<< adjust to fit

' Reference existing instance of PowerPoint
Set ppApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = ppApp.ActivePresentation
ppApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
With PPPres.Slides(ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)
' paste and select the chart picture
Set ppShape = .Shapes.Paste
ppShape.Left = aryLeft(iCht - 1)
ppShape.Align msoAlignMiddles, True
End With

Next

' Clean up
Set ppShape = Nothing
Set ppSlide = Nothing
Set PPPres = Nothing
Set ppApp = Nothing

End Sub