Create Graphs using VBA

[Vic]

Hello,

I trying to implement a routine to create Powerpoint slides using a function
from Microsoft Knowledge base 200551. There are 2 prolblems I am having
with this that I'm hoping someone here can help. I have included the code
from this site below.

The first one is the routine uses early binding to the the Powerpoint
library so the intellisense doesn't work. I am going to need to make some
modifications to this such as passing labels, changing chart types etc. and
it would relly help if the intellisense was working. My efforts to change
this have not been successfull.

These are the dimension statements I've changed:

'Dim oPwrpnt As Object, OpwrPresent As Object '<<=== this is
commented out
Dim OPwrPnt As PowerPoint.Application
Dim OpwrPresent As PowerPoint.Presentation

'Dim oDataSheet As Object, shpGraph As Object '<<=== this is
commented out
Dim oDataSheet As PowerPoint.DataTable
Dim shpGraph As PowerPoint.Shapes '<<=== Is this
correct?

The following Set statement does not compile - fails with "Method or Data
Member Not Found". It is failing on "Shapes" I assume there is an error in
my dim statemet above but I'm not sure how to dimension the shapes. If I
comment it out, others folling will fail.

Set shpGraph = OpwrPresent.Shapes.AddOLEObject(Left:=LLeft, _
Top:=lTop, Width:=lwidth, Height:=lheight, _
ClassName:="MSGraph.Chart", Link:=0).OLEFormat.Object

I'm really hoping that someone will take a look and tell me where I've gone
wrong!

Thanks,

Vic



Here's the full code:

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 oPwrpnt As Object, OpwrPresent As Object
Dim OPwrPnt As PowerPoint.Application '<<===
Dim OpwrPresent As PowerPoint.Presentation '<<===

'Dim oDataSheet As Object, shpGraph As Object
Dim oDataSheet As PowerPoint.DataTable '<<===
Dim shpGraph As PowerPoint.Shapes '<<=== Is this
correct?

Dim Shpcnt As Integer, FndGraph As Boolean
Dim lRowCnt, lColCnt, lValue As Long, CGFF_FldCnt As Integer

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
deffilename = CurrentProject.Path & "\SavedInterbrand.ppt"
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

' the following set
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
shpGraph.Application.Update
' Start a new 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
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
' MsgBox "PowerPoint Presentation File Constructed"

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

 

[Shyam Pillai]

Use

Dim shpGraph As PowerPoint.Shape

The reference is to a specific shape. For a group of shapes use ShapeRange.
Regards
Shyam Pillai

 

[Vic]

Thanks Shyam but unfortuniately it still throws the error "Method or Data
Member not found on Shapes in the following set:

Set shpGraph = OpwrPresent.Shapes.AddOLEObject(Left:=LLeft, _
Top:=lTop, Width:=lwidth, Height:=lheight, _
ClassName:="MSGraph.Chart", Link:=0).OLEFormat.Object

These are my dimensions:

Dim oPwrpnt As PowerPoint.Application
Dim OpwrPresent As PowerPoint.Presentation
Dim oDataSheet As PowerPoint.DataTable
Dim shpGraph As PowerPoint.Shape

Thanks Again,

Vic

 

[Shyam Pillai]

Yes, that is because the declaration is wrong.
OpwrPresent is declared as presentation.

Based on the rest of your code the declaration should be

Dim OpwrPresent as PowerPoint.Slide

Regards,
Shyam Pillai

 

[Vic]

Shyam,

You are so correct that did in fact get me to the next error. Now I think
the declaration for the DataSheet is wrong

Dim oDataSheet As PowerPoint.DataTable

I'm getting the same error on
' Clear the datasheet.
oDataSheet.Cells.Clear

How show the this be dimensioned??

Thank you Shyam I really appreciate your help. This is the first time I've
messed with PowerPoint so it's a real learning curve.


Vic