Microsoft KB Archive/177270

From BetaArchive Wiki
Knowledge Base


How to create a Graph object on a PowerPoint 97 for Windows slide in Access 97 by using Visual Basic for Applications

Article ID: 177270

Article Last Modified on 1/22/2007



APPLIES TO

  • Microsoft Access 97 Standard Edition
  • Microsoft PowerPoint 97 Standard Edition



This article was previously published under Q177270

SUMMARY

This article describes how to create a Microsoft Graph object on a Microsoft PowerPoint 97 for Windows slide in Microsoft Access 97 by using Microsoft Visual Basic for Applications.

This article assumes that you are familiar with Visual Basic for Applications and with creating Access 97 applications by using the programming tools that are provided with Access 97. For additional information about Visual Basic for Applications, see the "Building Applications with Microsoft Access 97" manual.

Note A demonstration of the technique that is used in this article can be seen in the sample file that is named Grphsm97.exe.

For additional information about how to obtain this file, click the following article number to view the article in the Microsoft Knowledge Base:

186855 Microsoft Access 97 sample graphs available in Download Center


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. To create a Microsoft Graph version 8.0 object on a Microsoft PowerPoint 97 slide, follow these steps:

CAUTION: Following the steps in this example will modify the sample database Northwind.mdb. You may want to back up the Northwind.mdb file and perform these steps on a copy of the database.

  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:

        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 Database, CGFF_TD As TableDef, CGFF_Rs As Recordset
        Dim CGFF_field As Field, 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 8 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 Debug window, and then press ENTER:

    ?CreateGraphFromFile("C:\MyPPT.ppt", "Category Sales for 1995","")
                            

    Note that a Microsoft PowerPoint 97 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:

163435 VBA: Programming Resources for Visual Basic for Applications


For more information about getting help with Microsoft PowerPoint 97 Programming and Automation using Visual Basic for Applications, please see the following article in the Microsoft Knowledge Base:

162307 PPT97: PowerPoint Articles Available by E-Mail: Programming


For more information about how to see if a table or query already exists, please see the following article in the Microsoft Knowledge Base:

113549 ACC: How to Determine If a Table or Query Exists



Additional query words: kbmacro vba OLE 8.0 ACC97

Keywords: kbhowto kbinterop kbprogramming KB177270