ACC2000: How to Create an MS Graph in PowerPoint Using Access

Article translations Article translations
Article ID: 200551 - View products that this article applies to.
This article was previously published under Q200551
Advanced: Requires expert coding, interoperability, and multiuser skills.

Expand all | Collapse all

SUMMARY

This article shows you how to use Automation to create a Microsoft Graph object on a Microsoft PowerPoint slide from Microsoft Access by using a Microsoft Access table.

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. CAUTION: If you follow the steps in this example, you modify the sample database Northwind.mdb. You may want to back up the Northwind.mdb file and follow these steps on a copy of the database.

To create a Graph version 9.0 object on a PowerPoint slide, follow these steps:

NOTE: The sample code in this article uses Microsoft Data Access Objects. For this code to run properly, you must reference the Microsoft DAO 3.6 Object Library. To do so, click References on the Tools menu in the Visual Basic Editor, and make sure that the Microsoft DAO 3.6 Object Library check box is selected.

  1. Open the sample database Northwind.mdb.
  2. Create a module and type the following line in the Declarations section, if it is not already there:
    Option Explicit
    					
  3. Type the following procedures:
    Option Compare Database
    
    Function CreateGraphFromFile(CGFF_PPTFileName As String, _
      CGFF_Tablename As String, CGFF_SavedPPT As String) As Boolean
    
        '********************************************************************
        'Function:  CreateGraphFromFile
        'Purpose:   Create a graph on a PowerPoint Slide using a Microsoft
        '           Access table.
        '
        'Arguments: CGFF_PPTFilename - name of the new PowerPoint presentation
        '           file that you want to create. You must include the file
        '           name and path.
        '
        '           CGFF_Tablename- name of the Microsoft Access table or query
        '
        '           CGFF_SavedPPT - name of a previously saved PowerPoint
        '           presentation with a graph object already on it. An
        '           empty string ("") if you want to use a blank presentation
        '
        '
        'Returns:  True if successful or False if not.
        '
        '****************************************************************
    
       On Error GoTo ERR_CGFF
       Dim oDataSheet As Object
       Dim shpGraph As Object, Shpcnt As Integer, FndGraph As Boolean
       Dim lRowCnt, lColCnt, lValue As Long, CGFF_FldCnt As Integer
       Dim OPwrPnt As Object, OpwrPresent As Object
       Dim CGFF_DB As DAO.Database, CGFF_TD As DAO.TableDef
       Dim CGFF_Rs As DAO.Recordset, CGFF_field As DAO.Field
       Dim CGFF_PwrPntloaded As Boolean
       Dim lheight, lwidth, LLeft, lTop As Single
    
       ' See if the CGFF Table already exists.
       If IsTableQuery("", CGFF_Tablename) Then
          Set CGFF_DB = CurrentDb
          Set CGFF_Rs = CGFF_DB.OpenRecordset(CGFF_Tablename, dbOpenSnapshot)
          On Error GoTo ERR_CGFF
    
          ' Set up the object references.
          On Error GoTo Err_CGFFOle
          CGFF_PwrPntloaded = False
          Set OPwrPnt = CreateObject("Powerpoint.application")
    
          ' Activate PowerPoint. If you do not want to see PowerPoint,
          ' remark the
          ' next line out.
          OPwrPnt.Activate
          CGFF_PwrPntloaded = True
    
          ' Use this line to Open a default saved presentation
          ' Set OpwrPresent = OPwrPnt.Presentations.Open(DefFileName).Slides(1)
    
          If CGFF_SavedPPT = "" Then
    
             ' Use these lines to create a new Graph object on the slide.
             Set OpwrPresent = OPwrPnt.Presentations.Add.Slides.Add(1, 12)
             lheight = OPwrPnt.ActivePresentation.PageSetup.SlideHeight / 2
             lwidth = OPwrPnt.ActivePresentation.PageSetup.SlideWidth / 2
             LLeft = OPwrPnt.ActivePresentation.PageSetup.SlideHeight / 4
             lTop = OPwrPnt.ActivePresentation.PageSetup.SlideHeight / 4
             Set shpGraph = OpwrPresent.Shapes.AddOLEObject(Left:=LLeft, _
             Top:=lTop, Width:=lwidth, Height:=lheight, _
             ClassName:="MSGraph.Chart", Link:=0).OLEFormat.Object
             FndGraph = True
          Else
    
             ' Use these lines if you already have a saved chart
             ' on a PowerPoint
             ' slide.
             Set OpwrPresent = _
             OPwrPnt.Presentations.Open(CGFF_SavedPPT).Slides(1)
             FndGraph = False
             For Shpcnt = 1 To OpwrPresent.Shapes.Count
    
                ' Check if shape is an OLE object.
                If OpwrPresent.Shapes(Shpcnt).Type = 7 Then
    
                   ' Check if OLE object is graph 9 object. The ProgID is
                   ' case sensitive.
                   If OpwrPresent.Shapes(Shpcnt).OLEFormat.ProgId = _
                     "MSGraph.Chart.8" Then
                      Set shpGraph = _
                      OpwrPresent.Shapes(Shpcnt).OLEFormat.Object
    
                      ' Found the graph.
                      FndGraph = True
                   End If
                End If
             Next Shpcnt
    
             ' If a graph was found.
          End If
          On Error GoTo ERR_CGFF
          If FndGraph Then
    
             ' Set the reference to the datasheet collection.
             Set oDataSheet = shpGraph.Application.DataSheet
    
             ' Clear the datasheet.
             oDataSheet.Cells.Clear
    
             ' These are the lines to set up you row headings You can make this
             ' anything you want.
             CGFF_FldCnt = 1
    
             ' Loop through the fields collection and get the field names.
             For Each CGFF_field In CGFF_Rs.Fields
                oDataSheet.Cells(CGFF_FldCnt, 1).Value = _
                  CGFF_Rs.Fields(CGFF_FldCnt - 1).Name
                CGFF_FldCnt = CGFF_FldCnt + 1
             Next CGFF_field
             lRowCnt = 1
    
             ' 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(CGFF_FldCnt, lRowCnt + 1).Value = _
                     CGFF_Rs.Fields(CGFF_FldCnt - 1).Value
                   CGFF_FldCnt = CGFF_FldCnt + 1
                Next CGFF_field
                lRowCnt = lRowCnt + 1
                CGFF_Rs.MoveNext
             Loop
    
             ' Update the graph.
             shpGraph.Application.Update
             DoEvents
             CGFF_Rs.Close
             CGFF_DB.Close
    
             ' Release the references and save the slide.
             OPwrPnt.ActivePresentation.SaveAs (CGFF_PPTFileName)
             DoEvents
             OPwrPnt.Quit
             CreateGraphFromFile = True
             GoTo Exit_CGFF
          Else   ' No graphs were found display an error.
             MsgBox "No graph objects were found on the Activepresentation", _
                vbOKOnly, "No Graphs!!!"
             OPwrPnt.Quit
             CreateGraphFromFile = False
             GoTo Exit_CGFF
          End If
       Else
    
          ' No table was found.
          MsgBox "There is not a recordset named " & CGFF_Tablename & _
            "In this database", vbOKOnly, "No Table!!!"
          CreateGraphFromFile = False
          Exit Function
       End If
    
    Err_CGFFOle:
       ' OLE error section when trying to communicate with PowerPoint.
       MsgBox "There was a problem Communicating with PowerPoint", vbOKOnly, _
         "No data file!!!"
       MsgBox Err & " " & Err.Description, vbOKOnly, "Data file problem!!!"
         CreateGraphFromFile = False
       If CGFF_PwrPntloaded Then
          OPwrPnt.Quit
       End If
       GoTo Exit_CGFF
    
    ERR_CGFF:
       ' General error section.
       MsgBox Err & " " & Err.Description, vbOKOnly, _
         "An Error has occurred with this application"
       CreateGraphFromFile = False
    
    Exit_CGFF:
       Set oDataSheet = Nothing
       Set OPwrPnt = Nothing
       Set OpwrPresent = Nothing
       Set shpGraph = Nothing
    
    End Function
    
    '********************************************************
    ' FUNCTION: IsTableQuery()
    '
    ' PURPOSE: Determine if a table or query exists.
    '
    ' ARGUMENTS:
    '   DbName: The name of the database. If the database name
    '           is "" the current database is used.
    '    TName: The name of a table or query.
    '
    ' RETURNS: True (it exists) or False (it does not exist).
    '
    '********************************************************
    
    Function IsTableQuery(DbName As String, TName As String) As Integer
       Dim Db As Database, Found As Integer, Test As String
    
       Const NAME_NOT_IN_COLLECTION = 3265
    
       ' Assume the table or query does not exist.
       Found = False
    
       ' Trap for any errors.
       On Error Resume Next
    
       ' If the database name is empty...
       If Trim$(DbName) = "" Then
    
          '...then set Db to the current Db.
          Set Db = CurrentDb()
       Else
          'Otherwise, set Db to the specified open database.
          Set Db = DBEngine.Workspaces(0).OpenDatabase(DbName)
    
          'See if an error occurred.
          If Err Then
             MsgBox "Could not find database to open: " & DbName
             IsTableQuery = False
             Exit Function
    
          End If
       End If
    
       ' See if the name is in the Tables collection.
       Test = Db.TableDefs(TName).Name
       If Err <> NAME_NOT_IN_COLLECTION Then Found = True
    
       ' Reset the error variable.
       Err = 0
    
       ' See if the name is in the Queries collection.
       Test = Db.QueryDefs(TName$).Name
       If Err <> NAME_NOT_IN_COLLECTION Then Found = True
       Db.Close
       IsTableQuery = Found
    End Function
    					
  4. To test this function, type the following line in the Immediate window, and then press ENTER:
    ?CreateGraphFromFile("C:\MyPPT.ppt", "Category Sales for 1997", "")
    						
    Note that a Microsoft PowerPoint Presentation file, called MyPPT.ppt,is created with a Bar chart. The CategoryName field is the column value heading and the CategorySales field contains the data for the chart.

REFERENCES

For more information about getting help with Visual Basic for Applications, please see the following article in the Microsoft Knowledge Base:
226118 OFF2000: Programming Resources for Visual Basic for Applications

Properties

Article ID: 200551 - Last Review: October 11, 2006 - Revision: 2.3
APPLIES TO
  • Microsoft Access 2000 Standard Edition
  • Microsoft PowerPoint 2000 Standard Edition
Keywords: 
kbinfo kbinterop kbprogramming KB200551

Give Feedback

 

Contact us for more help

Contact us for more help
Connect with Answer Desk for expert help.
Get more support from smallbusiness.support.microsoft.com