Заполнение Powerpoint слайды из Access VBA

Question

я пытаюсь заполнить несколько текстовых полей в файле Powerpoint, используя код ниже:

Private Sub OpenPPT_Click() 

Dim pptPres As PowerPoint.Presentation 
Dim pptApp As PowerPoint.Application 
Dim currentSlide As Slide 

Set pptApp = CreateObject("Powerpoint.Application") 
Set pptPres = pptApp.Presentations.Open("C:\Users\Magda\Desktop\TestReport.pptx") 
Set currentSlide = pptPres.Slides(pptPres.Slides.Count) 

'Slide 1 

currentSlide.Shapes("HomeTitle1").TextFrame.TextRange.Text = "This is the title" 
currentSlide.Shapes("HomeTitle2").TextFrame.TextRange.Text = "This is the subtitle" 

'Slide 2 

currentSlide.Shapes("MainTitle1").TextFrame.TextRange.Text = "This is the title" 
currentSlide.Shapes("Contents1").TextFrame.TextRange.Text = "Section1" 
currentSlide.Shapes("Contents2").TextFrame.TextRange.Text = "Section2" 
currentSlide.Shapes("Contents3").TextFrame.TextRange.Text = "Section3" 
currentSlide.Shapes("Contents4").TextFrame.TextRange.Text = "Section4" 

'Slide 3 

currentSlide.Shapes("MainTitle2").TextFrame.TextRange.Text = "Section1" 

End Sub 

Моя проблема заключается в том, что этот код кажется только установить текст в слайд 3 (заключительный слайд в PPT). Как я прокручиваю слайды, чтобы каждый заселялся?

Answer 1

Следующий код работает для меня, пробегает по каждому слайду (Access 2010 манипула PowerPoint 2010):

Option Compare Database 
Option Explicit 

Sub pptTest() 
    Dim pptApp As New PowerPoint.Application 
    Dim pptPres As PowerPoint.Presentation 
    Dim currentSlide As Slide 
    Dim i As Long 

    Set pptPres = pptApp.Presentations.Open("C:\Users\Gord\Desktop\TestReport.pptx") 
    For i = 1 To pptPres.Slides.Count 
     Set currentSlide = pptPres.Slides(i) 
     Debug.Print currentSlide.Name 
    Next 
    Set currentSlide = Nothing 
    pptPres.Close 
    Set pptPres = Nothing 
    pptApp.Quit 
    Set pptApp = Nothing 
End Sub 

Конечно, если вам нужно сделать немного разные вещи, чтобы каждый слайд можно просто сделать

Set currentSlide = pptPres.Slides(1) 
' do stuff for Slide 1 

Set currentSlide = pptPres.Slides(2) 
' do stuff for Slide 2 

' and so on