Sub CollagePlageCellules_DansPowerPoint()
'necessite d'activer la reference Microsoft Powerpoint Object Library
Dim PPT As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim NbShpe As Byte
Set PPT = CreateObject("Powerpoint.Application") 'creation session PowerPoint
PPT.Visible = True
Set PptDoc = PPT.Presentations.Open("C:\\maPresentation.ppt") 'ouverture fichier ppt
For i = 1 To 6
Range(Cells(24 + (21 * i), 1), Cells(44 + (21 * i), 22)).Select
Selection.Copy 'copie plage cellules de la feuille active
n = i
a = 0
If n > 3 Then
n = n - 3
a = 1
End If
PptDoc.Slides(n).Shapes.PasteSpecial ppPasteBitmap
'compte le nombre de shapes dans le 2eme slide
'le dernier objet inséré correspond à l'index le plus élevé
NbShpe = PptDoc.Slides(n).Shapes.Count
With PptDoc.Slides(n).Shapes(NbShpe)
.Name = "monTableau" & a 'personnaliser le nom de l'objet inséré
.Left = 0 'position horizontale dans le slide
.Top = 300 * a 'position verticale dans le slide
'.Height = 300 'hauteur image
.Width = 700 'largeur image
End With
Next
'PptDoc.Save 'sauvegarder les modifications
'PptDoc.Close 'fermer le document ppt
'PPT.Quit 'fermer l'application powerPoint
End Sub