Access data to Powerpoint Slides

[air1access]

I have lots of powerpoint slides I need to create every month. The slides are the same for every one. So I have a template basically that never changes.
The only thing that changes is the info on slides 2 (current date) and 4 (table in powerpoint).

I hoping there is a way to take a query of the data I need and automate the process of putting this data in the powerpoint table on slide 4, saving the .pptx file with a new name.
Sometimes its 1 record, sometimes its 6-8 records that could end up in the table on slide 4.

Any suggestions or ideas...?
Thanks in advance..!! I know there is a way..! lol

 

[Andrzejek]

Quick search on Google: "powerpoint get data from access" gave me this:

Click DataPoint in the PowerPoint menu.
[ol 1]
[li]Then click the List button of the Connections group.[/li]
[li]Position on the Microsoft Access node in the provider tree and click Add connection.[/li]
[li]Add connection. ...[/li]
[li]Click OK to establish a link to the database. ...[/li]
[li]Add table or query. ...[/li]
[li]Data refresh options. ...[/li]
[li]Preview data.[/li]
[/ol]


---- Andy

There is a great need for a sarcasm font.

 

[air1access]

Andrzejek,

That must be a PowerPoint Add-in. I don't have that option. I seen that too.
Any other suggestions?

I'm looking to use a access query to populate a single slide in a powerpoint .potx (template) file , and save it as a .pptx with a new file name.

Right now the powerpoint template file has a powerpoint created table inserted on slide 4 for entering a "process name". Each month we do a copy & paste exercise to populate the table in slide 4.
It doesn't have to be a table in slide 4 - it could be text boxes for each "process name" in the query if that's easier. I don't know?

Thanks for the suggestion though..!!
air1access

 

[Andrzejek]

You could also try the 'long way' around to connect to your Access.
PowerPoint have a 'build-in' VBA, like Access (hit Alt-F11 in PP to get to VBA editor). From there you can establish a (ADODB) connection to your Access and retrieve any data.

The DataPoint in the PowerPoint looks very powerful...

---- Andy

There is a great need for a sarcasm font.

 

[dhookom]

I have used data from SQL Server and Access to populate/update a PowerPoint.

This is simple code from within PPT which requires a reference to the MS Access Data Engine (depending on your version of Office)

Sub PullDataFromAccess()
    Dim db As DAO.database
    Dim rs As DAO.Recordset
    Dim strFolder As String
    Dim strAccessFile As String
    Dim strQueryName As String
    strFolder = "C:\temp\Resources\PPT\ConnectChartToAccess"
    strAccessFile = "DataForPPTChart.accdb"
    strQueryName = "qxtbSalesByMthRegion"
    Set db = DAO.OpenDatabase(strFolder & "\" & strAccessFile)
    Set rs = db.OpenRecordset(strQueryName)
    With rs
        Do Until .EOF
            Debug.Print .Fields(1)
            .MoveNext
        Loop
        .Close
    End With
End Sub

The object model in PPT is not like Access forms and reports. You would need to research this a little. Here the beginning of code that creates a chart on a slide.

Sub CreateChart1(sld As Slide)
    Dim myChart As Chart
    Dim gChartData As ChartData
    Dim gWorkBook As Excel.Workbook
    Dim gWorkSheet As Excel.Worksheet
    Dim intI As Integer, intJ As Integer
    Dim intPoint As Integer
    Dim intTarMultiplier As Integer   'for current compared with target for red or green
    Dim dblMaxY As Double, dblMaxScale As Double
    Dim strChartName As String
    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Dim intMth As Integer
    Dim intRow As Integer
    
    [COLOR=#4E9A06]' Create the chart and set a reference to the chart data.[/color]
    Set myChart = sld.Shapes.AddChart.Chart
    strChartName = myChart.Name
    Set gChartData = myChart.ChartData
    myChart.ChartType = xlLine
    myChart.HasLegend = True
    myChart.Legend.Position = xlLegendPositionTop
    myChart.ChartArea.Border.ColorIndex = 5
    With myChart.Axes(xlValue).TickLabels.Font
        .Size = 9
    End With
    With myChart.Axes(xlCategory).TickLabels.Font
        .Size = 9
    End With
    myChart.Legend.Font.Size = 9
    myChart.Axes(xlValue).MaximumScaleIsAuto = False
    myChart.Axes(xlValue).MinimumScaleIsAuto = False
    myChart.Axes(xlValue).MinimumScale = 6
    myChart.Axes(xlValue).MaximumScale = 10
    
    [COLOR=#4E9A06]' Set the Workbook and Worksheet references.[/color]
    Set gWorkBook = gChartData.Workbook
    Set gWorkSheet = gWorkBook.Worksheets(1)
    sld.Shapes(strChartName).Top = 200
    sld.Shapes(strChartName).Left = 20
    sld.Shapes(strChartName).Height = 200
    sld.Shapes(strChartName).Width = 300

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[strongm]

>Quick search on Google: "powerpoint get data from access" gave me this:

Andy, that is instructions on how to use a commercial Powerpoint add-on called Datapoint …

(ah, as I see you may have spotted …)

 

[combo]

Here's an old article that uses access to manipulate powerpoint:

https://docs.microsoft.com/en-us/pr...e/developer/office-2003/aa159920(v=office.11)

combo

 

[air1access]

Theres got to be a way to do this. I found several code examples that either add a new slide, or adds a text box (with text) to an existing slide.
Theres got to be a way to connect to power point template from ms access, go to a specific slide and add the results of a query to the specific slide, name the slide show, save and close. The query could have 1 record or 7. I need a text box for each record - so I'll need a loop function.

Any other suggestions?
Thanks for the help..!
air1access

 

[dhookom]

What code have you tried so far?

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[air1access]

I have been messing with the code below. Can't get it to work.
It looks like creates a new .pptx, and adds a powerpoint table (which would be best for me if I can get it to work), then adds the results of a query to the powerpoint table. If get an error on rs.Fields(1) and rs.Fields(c - 1).
Item not found in this collection.

Thanks for taking a look.
I hope you can read the code I posted. I don't know how to use the coding.

Dim db As DAO.Database
Dim rs As DAO.Recordset
'Dim Fields As DAO.Field
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim iFound As Integer
Dim cl As Cell
Dim rw As Row
Dim r As Integer
Dim c As Integer
Dim lLastProject As Long
lLastProject = 0
'On Error GoTo err_cmdOLEPowerPoint
' Open up a recordset on the Employees table.
Set db = CurrentDb
Set rs = db.OpenRecordset("query11", dbOpenDynaset)
'quProjectsInProgress: ClName-0 ProjectID-1 Department-2 CrewLead-3 PcentComplete-4

' Open up an instance of Powerpoint.
Set ppObj = New PowerPoint.Application
Set ppPres = ppObj.Presentations.Add

rs.MoveLast
iFound = rs.RecordCount

r = 2
rs.MoveFirst
'Setup the set of slides and populate them with data from the set of records.
With ppPres
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
With .Shapes _
.AddTable(iFound, 5, 0, 0, 0, 0)
'.AddTable(Rows, Columns, Left, Top, Width, Height)
'.AddTable(iFound, 5, 10, 10, 288, 216)
With .Table
'Format the first Row
'Color the first row
For Each cl In .Rows(1).Cells
cl.Shape.Fill.ForeColor.RGB = RGB(50, 125, 0)
Next cl
'Size the columns.
.Columns(1).Width = 200
.Columns(2).Width = 75
.Columns(3).Width = 150
.Columns(4).Width = 125
.Columns(5).Width = 75
'Populate the Header row
.Cell(1, 1).Shape.TextFrame.TextRange.Text = "Client"
.Cell(1, 2).Shape.TextFrame.TextRange.Text = "Project"
.Cell(1, 3).Shape.TextFrame.TextRange.Text = "Dept."
.Cell(1, 4).Shape.TextFrame.TextRange.Text = "Lead"
.Cell(1, 5).Shape.TextFrame.TextRange.Text = "% Done"
End With

'Populate the data rows.
With .Table
While Not rs.EOF
For c = 1 To 5
If r > iFound Then Exit For
Select Case c
Case 1, 2
'If rs.Fields(1) <> lLastProject Then
.Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
'End If
Case Else
.Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
End Select
Next 'c column
lLastProject = rs.Fields(1)
rs.MoveNext
r = r + 1
Wend
End With
End With
'.SlideShowTransition.EntryEffect = ppEffectBlindsVertical
End With
End With

 

[Andrzejek]

It does make a difference when you show your code as code:

Dim db As DAO.Database
Dim rs As DAO.Recordset[green]
'Dim Fields As DAO.Field[/green]
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim iFound As Integer
Dim cl As Cell
Dim rw As Row
Dim r As Integer
Dim c As Integer
Dim lLastProject As Long
lLastProject = 0[green]
'On Error GoTo err_cmdOLEPowerPoint
' Open up a recordset on the Employees table.[/green]
Set db = CurrentDb
Set rs = db.OpenRecordset("query11", dbOpenDynaset)[green]
'quProjectsInProgress: ClName-0 ProjectID-1 Department-2 CrewLead-3 PcentComplete-4

' Open up an instance of Powerpoint.[/green]
Set ppObj = New PowerPoint.Application
Set ppPres = ppObj.Presentations.Add

rs.MoveLast
iFound = rs.RecordCount

r = 2
rs.MoveFirst[green]
'Setup the set of slides and populate them with data from the set of records.[/green]
With ppPres
    With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
        With .Shapes _
            .AddTable(iFound, 5, 0, 0, 0, 0)[green]
            '.AddTable(Rows, Columns, Left, Top, Width, Height)
            '.AddTable(iFound, 5, 10, 10, 288, 216)[/green]
            With .Table[green]
                'Format the first Row
                'Color the first row[/green]
                For Each cl In .Rows(1).Cells
                    cl.Shape.Fill.ForeColor.RGB = RGB(50, 125, 0)
                Next cl[green]
                'Size the columns.[/green]
                .Columns(1).Width = 200
                .Columns(2).Width = 75
                .Columns(3).Width = 150
                .Columns(4).Width = 125
                .Columns(5).Width = 75[green]
                'Populate the Header row[/green]
                .Cell(1, 1).Shape.TextFrame.TextRange.Text = "Client"
                .Cell(1, 2).Shape.TextFrame.TextRange.Text = "Project"
                .Cell(1, 3).Shape.TextFrame.TextRange.Text = "Dept."
                .Cell(1, 4).Shape.TextFrame.TextRange.Text = "Lead"
                .Cell(1, 5).Shape.TextFrame.TextRange.Text = "% Done"
            End With
        [green]
            'Populate the data rows.[/green]
            With .Table
                While Not rs.EOF
                    For c = 1 To 5
                    If r > iFound Then Exit For
                    Select Case c
                        Case 1, 2[green]
                            'If rs.Fields(1) <> lLastProject Then[/green]
                            .Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
                           [green] 'End If[/green]
                        Case Else
                            .Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
                    End Select
                    Next [green]'c column[/green]
                    lLastProject = rs.Fields(1)
                    rs.MoveNext
                    r = r + 1
                Wend
            End With
        End With[green]
        '.SlideShowTransition.EntryEffect = ppEffectBlindsVertical[/green]
    End With
End With

Just highlight the code text and click on CODE icon


---- Andy

There is a great need for a sarcasm font.

 

[air1access]

Ok - lets see if this is better.
Thanks Andy..!!

Dim db As DAO.Database
 Dim rs As DAO.Recordset
 'Dim Fields As DAO.Field
 Dim ppObj As PowerPoint.Application
 Dim ppPres As PowerPoint.Presentation
 Dim iFound As Integer
 Dim cl As Cell
 Dim rw As Row
 Dim r As Integer
 Dim c As Integer
 Dim lLastProject As Long
 lLastProject = 0
 'On Error GoTo err_cmdOLEPowerPoint
 ' Open up a recordset on the Employees table.
 Set db = CurrentDb
 Set rs = db.OpenRecordset("query11", dbOpenDynaset)
 'quProjectsInProgress: ClName-0 ProjectID-1 Department-2 CrewLead-3 PcentComplete-4

 ' Open up an instance of Powerpoint.
 Set ppObj = New PowerPoint.Application
 Set ppPres = ppObj.Presentations.Add

 rs.MoveLast
 iFound = rs.RecordCount

 r = 2
 rs.MoveFirst
 'Setup the set of slides and populate them with data from the set of records.
 With ppPres
 With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
 With .Shapes _
 .AddTable(iFound, 5, 0, 0, 0, 0)
 '.AddTable(Rows, Columns, Left, Top, Width, Height)
 '.AddTable(iFound, 5, 10, 10, 288, 216)
 With .Table
 'Format the first Row
 'Color the first row
 For Each cl In .Rows(1).Cells
 cl.Shape.Fill.ForeColor.RGB = RGB(50, 125, 0)
 Next cl
 'Size the columns.
 .Columns(1).Width = 200
 .Columns(2).Width = 75
 .Columns(3).Width = 150
 .Columns(4).Width = 125
 .Columns(5).Width = 75
 'Populate the Header row
 .Cell(1, 1).Shape.TextFrame.TextRange.Text = "Client"
 .Cell(1, 2).Shape.TextFrame.TextRange.Text = "Project"
 .Cell(1, 3).Shape.TextFrame.TextRange.Text = "Dept."
 .Cell(1, 4).Shape.TextFrame.TextRange.Text = "Lead"
 .Cell(1, 5).Shape.TextFrame.TextRange.Text = "% Done"
 End With

 'Populate the data rows.
 With .Table
 While Not rs.EOF
 For c = 1 To 5
 If r > iFound Then Exit For
 Select Case c
 Case 1, 2
 'If rs.Fields(1) <> lLastProject Then
 .Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
 'End If
 Case Else
 .Cell(r, c).Shape.TextFrame.TextRange.Text = rs.Fields(c - 1)
 End Select
 Next 'c column
 lLastProject = rs.Fields(1)
 rs.MoveNext
 r = r + 1
 Wend
 End With
 End With
 '.SlideShowTransition.EntryEffect = ppEffectBlindsVertical
 End With
 End With

 

[Andrzejek]

I hope you do indent your code...
Use 'Preview' button before posting.


---- Andy

There is a great need for a sarcasm font.

 

[air1access]

Anybody have any other ideas or suggestions for a solution?
Still trying to work on this one.

Thanks in advance.
air1access

 

[air1access]

Anybody have any other ideas or suggestions for a solution?
Still trying to work on this one.

Thanks in advance.
air1access

 

[combo]

Have you tested if:
- you try to pass proper data?
- the cell is properly referenced?


combo

 

[Andrzejek]

I have never really played with PowerPoint, but I gave it a shot here.
New PP presentation

In the VBA Editor (Alt-F11) I created:

Option Explicit

Sub GetInfoFromDB()

End Sub

On one of the slides I did: Insert – Shapes – Action Buttons – Action Button Blank, and I set its text to “Data Base Info” (but the text does not matter).

In the Action Setting that showed up, in Mouse Click tab I selected option Run Macro and have chosen “GetInfoFromDB” from the list of macros. OK

Back to the VBA editor.
Tools – References… added: Microsoft ActiveX data Object 6.1 Library

Added to my GetInfoFromDB macro:

Option Explicit

Sub GetInfoFromDB()
Dim Cn As New ADODB.Connection
Dim rec As New ADODB.Recordset
Dim strOut As String

With Cn
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data " _
        & " Source=[red]W:\YourAccessDataBAse.mdb[/red];" _
        & "Persist Security Info=False;"
    .CursorLocation = adUseClient
    .Open
End With

With rec
    .Open "SELECT DISTINCT COUNTY " & vbNewLine _
        & " FROM COP " & vbNewLine _
        & " WHERE (COUNTY < 'BOONE') " & vbNewLine _
        & " ORDER BY COUNTY", Cn

    Do While Not .EOF
        If Len(strOut) = 0 Then
            strOut = !COUNTY.Value
        Else
            strOut = strOut & vbNewLine & !COUNTY.Value
        End If
        .MoveNext
    Loop

    .Close
End With
Set rec = Nothing

Cn.Close
Set Cn = Nothing

MsgBox strOut

End Sub

As an outcome, when I run my PP Presentation and I click on "Data Base Info" button, I've got a message box with some Counties from my Access data base.

Not very impressive, but it is a start.


---- Andy

There is a great need for a sarcasm font.