Sub CreationPpt()
Dim Ppt As PowerPoint.Application
Dim Pptd As PowerPoint.Presentation
Dim PptS As PowerPoint.Slide
Dim PptShape As PowerPoint.Shape
Dim Chemin As String
Dim I As Long
Dim AireTexte As Range
Chemin = ThisWorkbook.Path & "\Essai1.pptx"
Set AireTexte = Sheets("Sheet1").Range("A1").CurrentRegion
Set Ppt = CreateObject("Powerpoint.Application")
Ppt.Visible = True
Set Pptd = Ppt.Presentations.Add
For I = 1 To AireTexte.Count
Set PptS = Pptd.Slides.Add(Index:=I, Layout:=ppLayoutBlank)
With PptS
Set PptShape = .Shapes.AddTextbox(msoTextOrientationHorizontal, 160, 120, 450, 50)
PptShape.TextFrame.TextRange.Text = AireTexte(I)
Set PptShape = Nothing
End With
Set PptS = Nothing
Next I
Pptd.SaveAs Filename:=Chemin
Pptd.Close
Ppt.Quit
Set Pptd = Nothing: Set Ppt = Nothing: Set AireTexte = Nothing
End Sub