1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
| Option Explicit
'--- utilise la référence: Microsoft PowerPoint Object Library
Sub PPT_Test()
Dim PPT As PowerPoint.Application
Dim Pres As PowerPoint.Presentation
Dim kR As Long
'---
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
Set Pres = PPT.Presentations.Open(ThisWorkbook.Path & "\Essai PowerPoint.potx", , msoCTrue)
kR = 2
Do
With Pres.Slides(kR - 1)
.Shapes("ZoneTexte 1").TextFrame.TextRange.Text = Cells(kR, 1)
.Shapes("ZoneTexte 2").TextFrame.TextRange.Text = Cells(kR, 2)
End With
kR = kR + 1
If Cells(kR, 1) <> "" Then
Pres.Slides(kR - 2).Duplicate '--- copie/ajoute une diapo
Else
Exit Do
End If
Loop
'--- sauve (écrase sans avertissement version précédente ayant ce même nom)
Pres.SaveAs ThisWorkbook.Path & "\Essai PowerPoint.pptx"
'Pres.Close
'PPT.Quit
End Sub |
Partager