[RESOLVED] powerpoint chart based on ms access query

does anyone knows how to create a powerpoint pie chart based on ms access query?

I've got this code from MS article. it creates a powerpoint chart based on a query, but it uses the current default chart type in powerpoint (i'd like to know how to create a pie chart always)

+ a link for a a tutorial on controling powerpoint chart objects will be very nice!

here's the code:

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