从Access VBA填充Powerpoint幻灯片

Question

i am trying to populate some text fields in a powerpoint file using the below code:

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

My issue is that this code only seems to set text in slide 3 (final slide in PPT). How do i loop through the slides so that each gets populated?

Answer 1

The following code works for me, looping through each slide (Access 2010 manipulating 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

Of course, if you need to do slightly different things to each slide you could just do

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

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

' and so on