Copie graphique XL vers Powerpoint

Bonjour à tous

J'ai récupéré un code de Jon Peltier copiant tous les graphiques d'une feuille
XL et les collant comme image dans .PPT tout en extrayant le titre de chaque
graphique pour le mettre en titre de la diapo.

Cela marche très bien pour 1 feuille.
***Seulement, je cherche à réaliser la même opération pour plusieurs feuilles
sélectionnées ensembles. Ma modif ne marche pas (ce qui ne me surprend guère
:-<) Comment faire, svp?

***De plus, le titre collé dans .PPT est en taille 44, comment avec la même
macro le réduire à 24, svp aussi?

Merci zatous(tes) et bon (jenesaisqueljourchezvous) à tous :-)

J@@
PS : voici le code et mes modestes modifs :

'********
'code de Jon Peltier
Sub ChartsAndTitlesToPresentation()
' 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
Dim sTitle As String

Dim wks As Worksheet '<******ajouté

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

For Each wks In ActiveWorkbook.Windows(1).SelectedSheets '<******ajouté

For iCht = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(iCht).Chart

' get chart title
If .HasTitle Then
sTitle = .ChartTitle.Text
Else
sTitle = ""
End If

' remove title (or it will be redundant)
.HasTitle = False

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

' restore title
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
End If
End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
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
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

Next
Next '<******ajouté
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub
'********