Access - Add additional slides (based on initial slide and update objects from Query results

I have a template PPT file has a title slide and then a 2nd slide that has blank content with a header title and a table object with some elements that are placeholders.

PPT-Example.jpg
I am trying to find out if it is possible to step through results of an Access query and create a new slide from the template with the necessary fields populated in the title and the corresponding cells in the table.

I have tried to find references to this online and nothing seems to specifically step through the coding needs.

thanks for any help!

Adam
Adam EhrenworthLead Technology AnalystAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Adam EhrenworthLead Technology AnalystAuthor Commented:
I created the following code... it opens the necessary template PowerPoint but it will not make the necessary changes. I am trying to copy the 2nd slide and then update certain shapes on that newly create pages for each item in the recordset returned.

Option Compare Database




'Show/Hide Dropdown options based on Report Selection
Private Sub ReportType_AfterUpdate()

If Me.ReportType.Value = "HCCO Presentation" Then
Me.Company_Label.Visible = True
Me.Company.Visible = True
Me.HCCOOwner_Label.Visible = True
Me.HCCOOwner.Visible = True
Me.Interaction_Label.Visible = True
Me.Interaction.Visible = True
End If

If Me.ReportType.Value <> "HCCO Presentation" Then
Me.Company_Label.Visible = False
Me.Company.Visible = False
Me.HCCOOwner_Label.Visible = False
Me.HCCOOwner.Visible = False
Me.Interaction_Label.Visible = False
Me.Interaction.Visible = False
End If

End Sub



Private Sub RunReport_Click()
    
If Me.ReportType.Value = "HCCO Presentation" Then
    Dim db As Database, rs As Recordset
    Dim ppObj As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    
    On Error GoTo err_cmdOLEPowerPoint
    
    ' Open up a recordset on the Employees table.
    Set db = CurrentDb
    Set rs = db.OpenRecordset("RAMP_HCCOOwner_temp", dbOpenDynaset)
    
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application

    
    ' Setup the set of slides and populate them with data from the
    ' set of records.

     ppObj.Presentations.Open ("C:\PGHCC Tools\RAMP_ReportingDB\template\Committee_Meeting.pptx")
    
     On Error Resume Next
 
   
     
    For x = 1 To rs.RecordCount
    
     Set ppapp = GetObject(, "Powerpoint.Application")
     If ppapp Is Nothing Then
     Set ppapp = CreateObject("Powerpoint.Application")
     ppapp.Visible = True
     End If
             
                ActivePresentation.Slides(2).Duplicate
                ActivePresentation.Slides(ActivePresentation.Slides.Count).MoveTo toPos:=ActivePresentation.Slides.Count + 1
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(3).TextFrame.TextRange.Text = CStr(rs.Fields("Title").Value)
                rs.MoveNext
    
    Next
    
    Exit Sub
    
err_cmdOLEPowerPoint:
    MsgBox Err.Number & " " & Err.Description
End If

    
    
End Sub

Open in new window

0
Rgonzo1971Commented:
Hi,

Since you are in Access you have to reference the PP object if you want to use its properties

                ppapp.ActivePresentation.Slides(2).Duplicate
                ppapp.ActivePresentation.Slides(ppapp.ActivePresentation.Slides.Count).MoveTo toPos:=ppapp.ActivePresentation.Slides.Count + 1
                ppapp.ActivePresentation.Slides(ppapp.ActivePresentation.Slides.Count).Shapes(3).TextFrame.TextRange.Text = CStr(rs.Fields("Title").Value)

Open in new window

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.