Create PowerPoint charts from MS Access queries

Question

I have an Access db to track metrics and "number crunch" data to build PowerPoint presentations. I do about 40 presentations per month, and they are 98% charts.

I run queries one at a time (using SQL statements), take the resulting data and copy it into an Excel template (I made a mock table in this "template" so the chart is already built and formatted), then copy the chart as a picture into a PowerPoint template.

So there is a lot of manual work.

How can I run multiple queries in Access with VBA on the same dataset/table (I have to do sales by quarter, by month, by region, by state, by site and all of these are Top5 aggregate, hence the reasons for the charts), and then send the resulting data to a specific Excel workbook, while defining what goes into what cell range?

If I get all the data into Excel, and have the charts ready to go, is there some VBA that will take the charts from Excel (activeworksheet) and paste them into PowerPoint as pictures in a quad view layout?

Can I do the same thing with an Access to PowerPoint approach and cut out Excel?

I am a novice at best.

Answer 1

You don't need to use Excel at all ! Use MS Access Charts in a report and some VBA code to put them into Powerpoint directly. There is already an example here

One "gotcha" is if you generate graphs in a group ie you design the report with a graph that is inside a group - so when you run the report you will get numerous graphs created.

It is a bit tricky to get hold of each of these graphs and drop them into Powerpoint but here is some code that will take care of it. This works in Access 2003

'Loop through all the controls in this report and pickout all the graphs
For Each c In pReport.Controls

    'Graphs initially appear to be in an Object Frame
    If TypeOf c Is ObjectFrame Then

        'Check the Class of the object to make sure its a Chart
        If Left$(c.Class, 13) = "MSGraph.Chart" Then

            'Check if this graph must be cloned (required if the graph is in a group in the MS Access report)
            If Not IsGraphToBeCloned(pReport.Name, c.ControlName) Then

                InsertGraphToPptSlide c, "", pReport.Name
            Else
                InsertGraphGroupToPpt pReport.Name, c
            End If
        End If
    End If
Next

This will find all the graphs in the report, if the graph is in a group then we call the InsertGraphGroupToPPt function.

The trick here is that we know we have the same base graph multiple times - but populated with different data. So in Powerpoint what you need to do is paste the base graph into powerpoint slides n times - where n is the number of groups and then update the graphs query properties

eg

Function UpdateGraphInPowerpoint(sql As String, OrigGraph As ObjectFrame, Groups As dao.Recordset, GroupName As String, ReportName As String) As Boolean


    //Copyright Innova Associates Ltd, 2009
    On Error GoTo ERR_CGFF
    On Error GoTo ERR_CGFF

    Dim oDataSheet As DataSheet
    Dim Graph As Graph.Chart
    Dim lRowCnt, lColCnt, lValue As Long, CGFF_FldCnt As Integer
    Dim CGFF_Rs As dao.Recordset
    Dim CGFF_field As dao.Field
    Dim CGFF_PwrPntloaded As Boolean
    Dim lheight, lwidth, LLeft, lTop As Single
    Dim slidenum As Integer
    Dim GraphSQL As String
    Dim lGrpPos As Long

    'Loop thru groups
    Do While Not Groups.EOF

        'We want content to be added to the end of the presentation - so find out how many slides we already have
        slidenum = gPwrPntPres.Slides.Count
        OrigGraph.Action = acOLECopy            'Copy to clipboard
        slidenum = slidenum + 1                 'Increment the Ppt slide number
        gPwrPntPres.Slides.Add slidenum, ppLayoutTitleOnly   'Add a Ppt slide

        'On Error Resume Next    'Ignore errors related to Graph caption
        gPwrPntPres.Slides(slidenum).Shapes(1).TextFrame.TextRange.Text = ReportName & vbCrLf & "(" & Groups.Fields(0).Value & ")" 'Set slide title to match graph title
        gPwrPntPres.Slides(slidenum).Shapes(1).TextFrame.TextRange.Font.Size = 16

        gPwrPntPres.Slides(slidenum).Shapes.Paste  'Paste graph into ppt from clipboard

        Set Graph = gPwrPntPres.Slides(slidenum).Shapes(2).OLEFormat.Object

        Set oDataSheet = Graph.Application.DataSheet    ' Set the reference to the datasheet collection.
        oDataSheet.Cells.Clear                          ' Clear the datasheet.

        GraphSQL = Replace(sql, "<%WHERE%>", " where " & GroupName & " = '" & Groups.Fields(0).Value & "'")
        Set CGFF_Rs = ExecQuery(GraphSQL)


        CGFF_FldCnt = 1
        ' Loop through the fields collection and get the field names.
        For Each CGFF_field In CGFF_Rs.Fields
            oDataSheet.Cells(1, CGFF_FldCnt).Value = CGFF_Rs.Fields(CGFF_FldCnt - 1).Name
           CGFF_FldCnt = CGFF_FldCnt + 1
        Next CGFF_field

        lRowCnt = 2
        ' Loop through the recordset.
        Do While Not CGFF_Rs.EOF

            CGFF_FldCnt = 1
            ' Put the values for the fields in the datasheet.
            For Each CGFF_field In CGFF_Rs.Fields
               oDataSheet.Cells(lRowCnt, CGFF_FldCnt).Value = IIf(IsNull(CGFF_field.Value), "", CGFF_field.Value)
               CGFF_FldCnt = CGFF_FldCnt + 1

            Next CGFF_field

            lRowCnt = lRowCnt + 1
            CGFF_Rs.MoveNext
        Loop

        ' Update the graph.
        Graph.Application.Update

        DoEvents

        CGFF_Rs.Close
        DoEvents
        Groups.MoveNext
    Loop

    UpdateGraphInPowerpoint = True
    Exit Function


End Function