Mark,
I would assume you need to add another loop to cycle through all the
worksheets. e.g.
Dim WS as worksheet

For each ws in thisworkbook.worksheet
'For iCht = 1 To ActiveSheet.ChartObjects.Count
For iCht = 1 To WS.ChartObjects.Count
'Code, adjusted to WS instead of ActiveSheet
Next
Next

NickHK

"Mark Ivey" wrote in message
...
Below is some code from Jon Peltier's website for transferring all charts
from one worksheet to a presentation. I have tried several times to figure
out how to get this to cycle through the workbook and get every chart in the
workbook to do the same, but I cannot seem to figure it out. Can anyone help
me with this? I have opted to paste in Jon Peltier's original code since I
kept bugging up what was already there...
Thanks in advance...



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