MS Access 2003 - Y at-il un moyen de définir les données par programmation d'un graphique?
-
24-09-2019 - |
Question
J'ai quelques VBA pour prendre des cartes construites avec l'Assistant graphique du formulaire, et insérer automatiquement dans les diapositives de présentation PowerPoint. J'utilise ces formes graphiques comme des sous formes dans une forme plus vaste qui a des paramètres que l'utilisateur peut choisir de déterminer ce qui est sur le graphique. L'idée est que l'utilisateur peut déterminer le paramètre, construire le tableau à sa / son goût, et cliquez sur un bouton et l'avoir dans une diapositive ppt avec le modèle de base de l'entreprise, bla bla bla .....
Il fonctionne, mais il est très volumineux en termes de quantité d'objets que je dois utiliser pour y parvenir.
J'utilise des expressions telles que:
like forms!frmMain.Month&*
pour obtenir les valeurs d'entrée dans les requêtes enregistrées, ce qui était très bien quand j'ai commencé, mais il est allé plus si bien et ils veulent tellement d'options, qu'il conduit le nombre de requêtes enregistrées / objets vers le haut. J'ai besoin plusieurs formes enregistrées avec des graphiques en raison du nombre de différents types de graphiques que je dois avoir ce pouvoir gérer.
ENFIN MA QUESTION:
Je ferais bien plutôt tout cela à la volée avec un certain VBA. Je sais comment insérer des zones de liste et zones de texte sur un formulaire, et je sais comment utiliser SQL dans VBA pour obtenir les valeurs que je veux de tables / requêtes à l'aide VBA, je ne sais pas s'il y a un certain vba je peux utiliser pour définir les valeurs de données des graphiques à partir d'un jeu d'enregistrements obtenu:
DIM rs AS DAO.Rescordset
DIM db AS DAO.Database
DIM sql AS String
sql = "SELECT TOP 5 Count(tblMain.TransactionID) AS Total, tblMain.Location FROM
tblMain WHERE (((tblMain.Month) = """ & me.txtMonth & """ )) ORDER BY Count
(tblMain.TransactionID) DESC;"
set db = currentDB
set rs = db.OpenRecordSet(sql)
rs.movefirst
some kind of cool code in here to make this recordset
the data of chart in frmChart ("Chart01")
Merci pour votre aide. Désolé pour la longueur de l'explication.
La solution
Il est possible de modifier l'ensemble de données directement dans vba comme je l'ai réussi à le faire. Cependant, la performance n'est pas si bon donc je suis retourné à remplir les résultats à une table temporaire et en fondant le graphique sur ce (voir ma seule question posée stackoverflow) si l'ensemble de données est assez petite, vous pouvez certainement le faire fonctionner. Je ne suis pas dans le bureau, mais si vous voulez le code que je peux poster lundi
EDIT: voici le vieux module de code je. C'est la chose complète, mais la partie clé que vous allez regarder est la partie d'ouvrir la fiche technique du graphique, puis en changeant la valeur de celui-ci comme celui-ci .cells (1,0) = « Badger ».
Je jetai enevtly cette méthode et je suis allé avec une table temporaire comme dans mon application graphique est redessiner beaucoup et je devais aller pour la méthode la plus rapide possible de donner un « temps réel » se sentir à lui, mais il pourrait être juste très bien pour vos besoins
Public Sub Draw_graph(strGraph_type As String)
Dim objGraph As Object
Dim objDS As Object
Dim i As Byte
On Error GoTo Error_trap
Dim lRT_actual As Long
Dim lRT_forecast As Long
Dim Start_time As Long
Dim aCell_buffer(49, 4) As Variant
Me.acxProgress_bar.Visible = True
Me.acxProgress_bar.Value = 0
Set objGraph = Me.oleCall_graph.Object
Set objDS = objGraph.Application.datasheet
Start_time = GetTime()
With objDS
.cells.Clear
Select Case strGraph_type
Case Is = "Agents"
'**************************
'** Draw the agent graph **
'**************************
.cells(1, 1) = "Start Time"
.cells(1, 2) = "Provided"
.cells(1, 3) = "Required"
.cells(1, 4) = "Actual Required"
For i = 1 To 48
.cells(i + 1, 1) = Format(DateAdd("n", (i - 1) * 15, "08:00:00"), "HHMM")
If Me.Controls("txtAgents_pro_" & i) > 0 Then
.cells(i + 1, 2) = Me.Controls("txtAgents_pro_" & i) + Me.Controls("txtAgents_add_" & i)
Else
.cells(i + 1, 2) = 0
End If
If Me.Controls("txtAgents_req_" & i) > 0 Then
.cells(i + 1, 3) = Me.Controls("txtAgents_req_" & i)
End If
If Me.Controls("txtActual_" & i) > 0 Then
.cells(i + 1, 4) = Erlang_Agents(Me.txtServiceLevel, Me.txtServiceTime, Me.Controls("txtActual_" & i) * 4, Me.txtAVHT + CLng(Nz(Me.txtDaily_AVHT_DV, 0)))
End If
'update the progress bar
If Me.acxProgress_bar.Value + 2 < 100 Then
Me.acxProgress_bar.Value = Me.acxProgress_bar.Value + 2
Else
Me.acxProgress_bar.Value = 90
End If
Next i
Case Is = "Calls"
'**************************
'** Draw the Calls graph **
'**************************
.cells(1, 1) = "Start Time"
.cells(1, 2) = "Forecast"
.cells(1, 3) = "Actual"
For i = 1 To 48
.cells(i + 1, 1) = Format(DateAdd("n", (i - 1) * 15, "08:00:00"), "HHMM")
If Me.Controls("txtForecast_" & i) > 0 Then
.cells(i + 1, 2) = Me.Controls("txtForecast_" & i)
Else
.cells(i + 1, 2) = 0
End If
If Me.Controls("txtActual_" & i) > 0 Then
.cells(i + 1, 3) = Me.Controls("txtActual_" & i)
End If
If Me.acxProgress_bar.Value + 2 < 100 Then
Me.acxProgress_bar.Value = Me.acxProgress_bar.Value + 2
Else
Me.acxProgress_bar.Value = 90
End If
Next i
Case Is = "Call Deviation"
'**************************
'** Draw the Call Deviation graph **
'**************************
.cells(1, 1) = "Start Time"
.cells(1, 2) = "Deviation"
lRT_actual = 0
lRT_forecast = 0
For i = 1 To 48
lRT_actual = lRT_actual + Me.Controls("txtActual_" & i)
lRT_forecast = lRT_forecast + Me.Controls("txtForecast_" & i)
.cells(i + 1, 1) = Format(DateAdd("n", (i - 1) * 15, "08:00:00"), "HHMM")
.cells(i + 1, 2) = lRT_actual - lRT_forecast
If Me.acxProgress_bar.Value + 2 < 100 Then
Me.acxProgress_bar.Value = Me.acxProgress_bar.Value + 2
Else
Me.acxProgress_bar.Value = 90
End If
Next i
Case Is = "Call Deviation %"
'**************************
'** Draw the Call Deviation % graph **
'**************************
.cells(1, 1) = "Start Time"
.cells(1, 2) = "Deviation"
lRT_actual = 0
lRT_forecast = 0
For i = 1 To 48
lRT_actual = lRT_actual + Me.Controls("txtActual_" & i)
lRT_forecast = lRT_forecast + Me.Controls("txtForecast_" & i)
.cells(i + 1, 1) = Format(DateAdd("n", (i - 1) * 15, "08:00:00"), "HHMM")
If lRT_forecast > 0 Then
.cells(i + 1, 2) = (lRT_actual - lRT_forecast) / lRT_forecast
End If
If Me.acxProgress_bar.Value + 2 < 100 Then
Me.acxProgress_bar.Value = Me.acxProgress_bar.Value + 2
Else
Me.acxProgress_bar.Value = 90
End If
Next i
Case Is = "SLA"
'**************************
'*** Draw the SLA graph ***
'**************************
.cells(1, 1) = "Start Time"
.cells(1, 2) = "SLA"
.cells(1, 3) = "Actual SLA"
For i = 1 To 48
.cells(i + 1, 1) = Format(DateAdd("n", (i - 1) * 15, "08:00:00"), "HHMM")
If Me.Controls("txtSLA_" & i) > 0 Then
.cells(i + 1, 2) = Me.Controls("txtSLA_" & i) / 100
Else
.cells(i + 1, 2) = 0
End If
If Me.Controls("txtActual_SLA_" & i) > 0 Then
.cells(i + 1, 3) = Me.Controls("txtActual_SLA_" & i)
End If
If Me.acxProgress_bar.Value + 2 < 100 Then
Me.acxProgress_bar.Value = Me.acxProgress_bar.Value + 2
Else
Me.acxProgress_bar.Value = 90
End If
Next i
End Select
End With
Set objDS = Nothing
Set objGraph = Nothing
Me.acxProgress_bar.Visible = False
Exit Sub
Error_trap:
DoCmd.Hourglass False
MsgBox "An error happened in sub Draw_graph, error description, " & Err.Description, vbCritical, "Tracker 3"
End Sub
Autres conseils
Un moyen très facile de le faire est de baser le tableau sur une requête et mettre à jour la requête, par exemple:
strSQL = "SELECT ..."
QueryName = "qryByHospital"
If IsNull(DLookup("Name", "MsysObjects", "Name='" & QueryName & "'")) Then
CurrentDb.CreateQueryDef QueryName, strSQL
Else
CurrentDb.QueryDefs(QueryName).SQL = strSQL
End If
DoCmd.OpenReport "rptChartByHospital", acViewPreview