The information in this article applies to:
- Microsoft Access 97
- Microsoft PowerPoint 97 for Windows
SUMMARY
This article demonstrates how to create a Microsoft Graph object on a
Microsoft PowerPoint 97 slide from Microsoft Access 97 through Automation
using a Microsoft Access table.
This article assumes that you are familiar with Visual Basic for
Applications and with creating Microsoft Access applications using the
programming tools provided with Microsoft Access. For more information
about Visual Basic for Applications, please refer to the "Building
Applications with Microsoft Access 97" manual.
MORE INFORMATION
Microsoft provides programming examples for illustration only, without
warranty either expressed or implied, including, but not limited to, the
implied warranties of merchantability and/or fitness for a particular
purpose. This article assumes that you are familiar with the programming
language being demonstrated and the tools used to create and 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
needs. If you have limited programming experience, you may want to contact
the Microsoft fee-based consulting line at (800) 936-5200. For more
information about the support options available from Microsoft, please see
the following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/refguide/default.asp
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.
- Open the sample database Northwind.mdb.
- Create a module and type the following line in the Declarations
section, if it is not already there:
Option Explicit
- 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
- To test this function, type the following line in the Debug window,
and then press ENTER
?CreateGraphFromFile("C:\MyPPT.ppt", "Category Sales for 1995","")
Results:
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:
ARTICLE-ID: Q163435
TITLE : 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:
ARTICLE-ID: Q162307
TITLE : Microsoft PowerPoint 97 Programming, Automation
For more information about how to see if a table or query already exists,
please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q113549
TITLE : ACC: How to Determine If a Table or Query Exists
|