MS Access 2003中 - 有没有一种方法以编程方式定义图表的数据?
-
24-09-2019 - |
题
所以我有一些VBA采取与窗体的图表向导建立图表,并自动将其插入到PowerPoint演示文稿的幻灯片。我使用这些图表-形式作为较大形式,其具有参数,用户可以选择,以确定哪些是在图表上内的子形式。我们的想法是,用户可确定参数,绘制图表他/她喜欢,并单击一个按钮,它必须与公司的背景模板,PPT幻灯片,等等等等......
所以它的工作原理,但它是我用来实现这个目标的数量方面是非常庞大的。
我使用表达式如下面的:
like forms!frmMain.Month&*
要获得输入值到保存的查询,这是很好,当我第一次开始,但它走过去这么好,他们要这么多的选择,它是推动保存的查询数量/对象了。我需要,因为不同类型的图表数量图表几个保存的表单,我需要有这个能够处理。
所以最后我的问题:
我宁愿做这一切与一些VBA飞。我知道如何插入列表框和文本框的窗体上,我知道如何使用SQL在VBA得到我使用VBA表/查询需要的值,我只是不知道是否有一些VBA我可以使用从所得的记录设定的图表的数据值:
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")
感谢您的帮助。道歉解释的长度。
解决方案
有可能直接在VBA改变数据集作为我已成功地做到这一点。然而,表现也不是那么好,所以我又回到了填充结果临时表和基础图上(见我只问了计算器的问题),但是如果数据集是相当小的,那么你当然可以使它发挥作用。我不在办公室,但如果你想要的代码,我可以张贴在周一
编辑:这里是我使用的旧的代码模块。这是一个完整的东西,但你要寻找的关键部分是对开放图表的数据表,然后改变它的价值这样.cells(1,0)=“獾”的部分。
我enevtly甩这种方法,并用临时表就在我的应用程序的图形是重绘了很多,我需要去的最快的方法给一个“实时”的感觉,但它可能是刚精细您的需求。
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
其他提示
这样做的一种非常简单的方法是立足于一个查询图表和更新查询,例如:
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