Paste all charts in WORKBOOK into powerpoint

[vbaNewby]

Hello,

I found this nifty piece of code that will paste all the charts from the active worksheet into a new powerpoint slide, one slide per chart . I would like to adapt this to paste every chart from the active workbook (including every worksheet)

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

http://peltiertech.com/Excel/XL_PPT.html#chartsslides

Any help with doing so? I've tried the following:

   For Cht = 1 To ActiveWorkbook.Charts.count
    ' copy chart as a picture
    ActiveWorkbook.Charts(Cht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

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

Next

ActiveWorkbook.Charts.count is returning a count of zero, there are a bunch of charts in my workbook however.

Any help appreciated!

</pre>

 

[vbaNewby]

Nevermind, found my solution right after I posted. You have to loop thru each worksheet and then loop through each chart. Cheers!

  For Each ws In ActiveWorkbook.Worksheets
     For Each coChart In ws.ChartObjects
    ' copy chart as a picture
    coChart.CopyPicture '_
    ' Add a new slide and paste in the chart
    SlideCount = PP.Slides.count
    Set PS = PP.Slides.Add(SlideCount + 1, ppLayoutBlank)
    PA.ActiveWindow.View.GotoSlide PS.SlideIndex
    With PS
        ' paste and select the chart picture
        .Shapes.Paste.Select
        ' align the chart
        PA.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        PA.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    End With
    Next
Next