Voor een standaard rapportage wil ik een set grafieken in een powerpoint presentatie vullen met data uit access tabellen.
Nu heb ik een stuk VBA code gevonden waarmee ik de data die in een Access tabel staat direct in de tabel van een grafiekobject in een slide van een powerpointpresentatie kan zetten. Dit werkt prima en heb ik werkend; alleen wil ik nu in 1 run een hele set aan grafieken met verschillende tabellen vullen. En de code die ik nu heb doet er dus maar 1:
ACC2000: How to Create an MS Graph in PowerPoint Using Access
Hierbij heb je 3 parameters die ingevoerd moeten worden:
- De locatie waar de powerpoint wordt opgeslagen
- De access tabel waar de data in staat
- Optioneel een 'template' presentatie (die ik dus gebruik) waar de grafieken in gevuld worden
De bijkomende uitdaging wordt dat ik op 1 slide 2 grafieken kan hebben, dus moet ik ook nog het juiste grafiek object zien te selecteren.
De orignele code heb ik 'gestript' tot het volgende en dat is nog werkend:
Als ik nu een 2e slide wil vullen, moet ik volgens mij dit stuk 'herhalen' (waarschijnlijk kan dit makkelijker/ mooier, maar ik zou niet weten hoe)
Als ik dit stuk tussenvoeg, krijg ik geen error, maar het probleem is nu dat hij opnieuw de template oppakt en niet gewoon naar de volgende slide gaat. Hoe verander ik de volgende code (waar het volgens mij in zit) zodat hij het stukje Open() niet nodig heeft?:
Andere vraag is dus hoe ik een 2e grafiekobject kan selecteren in 1 slide en dan die kan vullen met data? Volgens mij zit dat in de volgende code:
Nu heb ik een stuk VBA code gevonden waarmee ik de data die in een Access tabel staat direct in de tabel van een grafiekobject in een slide van een powerpointpresentatie kan zetten. Dit werkt prima en heb ik werkend; alleen wil ik nu in 1 run een hele set aan grafieken met verschillende tabellen vullen. En de code die ik nu heb doet er dus maar 1:
ACC2000: How to Create an MS Graph in PowerPoint Using Access
Hierbij heb je 3 parameters die ingevoerd moeten worden:
Code:
?CreateGraphFromFile("C:\MyPPT.ppt", "Category Sales for 1997", "")- De access tabel waar de data in staat
- Optioneel een 'template' presentatie (die ik dus gebruik) waar de grafieken in gevuld worden
De bijkomende uitdaging wordt dat ik op 1 slide 2 grafieken kan hebben, dus moet ik ook nog het juiste grafiek object zien te selecteren.
De orignele code heb ik 'gestript' tot het volgende en dat is nog werkend:
Code:
Option Explicit
Option Compare Database
Function CreateGraphPPT(CGFF_PPTFileName As String, _
CGFF_Tablename As String, CGFF_SavedPPT As String) As Boolean
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.
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 these lines if you already have a saved chart
' on a PowerPoint
' slide.
Set OpwrPresent = _
OPwrPnt.Presentations.Open(CGFF_SavedPPT).Slides(2)
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.
On Error GoTo ERR_CGFF
' 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
CreateGraphPPT = True
GoTo Exit_CGFF
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!!!"
CreateGraphPPT = 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"
CreateGraphPPT = False
Exit_CGFF:
Set oDataSheet = Nothing
Set OPwrPnt = Nothing
Set OpwrPresent = Nothing
Set shpGraph = Nothing
End FunctionAls ik nu een 2e slide wil vullen, moet ik volgens mij dit stuk 'herhalen' (waarschijnlijk kan dit makkelijker/ mooier, maar ik zou niet weten hoe)
Code:
Set CGFF_DB = Nothing
Set CGFF_Rs = Nothing
Set OpwrPresent = Nothing
Set CGFF_DB = CurrentDb
Set CGFF_Rs = CGFF_DB.OpenRecordset("Table2", dbOpenSnapshot)
' Use these lines if you already have a saved chart
' on a PowerPoint
' slide.
Set OpwrPresent = _
OPwrPnt.Presentations.Open(CGFF_SavedPPT).Slides(3)
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.
On Error GoTo ERR_CGFF
' 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.CloseAls ik dit stuk tussenvoeg, krijg ik geen error, maar het probleem is nu dat hij opnieuw de template oppakt en niet gewoon naar de volgende slide gaat. Hoe verander ik de volgende code (waar het volgens mij in zit) zodat hij het stukje Open() niet nodig heeft?:
Code:
Set OpwrPresent = _
OPwrPnt.Presentations.Open(CGFF_SavedPPT).Slides(3)Andere vraag is dus hoe ik een 2e grafiekobject kan selecteren in 1 slide en dan die kan vullen met data? Volgens mij zit dat in de volgende code:
Code:
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
