I have noticed an error in what I posted earlier (sorry!), but the
following procedure works just fine:

Sub ChartSheetsToPowerPointSlides()
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
Dim f As Object

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True

' Insère une nouvelle presentation.

Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPApp.ActiveWindow.ViewType = ppViewSlide

' Copie le graphique en image

For Each f In ActiveWorkbook.Charts
' don't need to activate the slide
f.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture

SlideCount = PPPres.Slides.Count
' insert new slide for each chart picture
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
.Shapes.Range(.Shapes.Count).Align msoAlignCenters, True
.Shapes.Range(.Shapes.Count).Align msoAlignMiddles, True
End With

Next
End Sub

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______

wrote:

Thanks Jon.
There must be something I don't get because it's not working fine.
Here's my code :

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
Dim f As Object

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True

' Insère une nouvelle presentation.

Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPApp.ActiveWindow.ViewType = ppViewSlide

' Copie le graphique en image

For Each f In ActiveWorkbook.Charts

Sheets(f.Name).Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlPicture

SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
End With


PPApp.ActiveWindow.Selection.SlideRange.Shapes.Ran ge(PPApp.ActiveWindow.Selection.SlideRange.Shapes. Count).Align
msoAlignCenters, True


SlideCount = SlideCount + 1

Next

Can you tell me what's wrong ? Except ME !!
Thank you.