' Prépare le PPT de présentation
Set pptapp = CreateObject("PowerPoint.Application")
Set ppt = pptapp.Presentations.Add
i = Sheets.Count
For i = Sheets.Count To 7 Step -1
Sheets(i).Select
With pptapp
Set newSlide = ppt.Slides.Add(1, 12) ' ppLayoutBlank = 12
ActiveSheet.Range("A1:Q37").Copy
newSlide.Shapes.PasteSpecial DataType:=2 'LIGNE QUI CREER LE BUG
Set Graphic = GetObject(, "Powerpoint.Application")
With Graphic.ActiveWindow.Selection.ShapeRange
.Left = 20
.Top = 20
.Width = 640
.Height = 100
End With
ppt.SaveAs Filename:="M:\7-CFR\6-SectionConduiteStages\SUIVI INSTRUCTION\ETATS STAGIAIRES\Commission\Commission_CDM.pptx"
End With
Next i
AppActivate "Excel"
Sheets(1).Select