MS Access 2003の - プログラムでグラフのデータを定義する方法はありますか?
-
24-09-2019 - |
質問
だから私は、フォームのグラフウィザードで構築されたチャートを取って、そして自動的にパワーポイントプレゼンテーションのスライドに挿入するためのいくつかのVBAを持っています。私は、ユーザがチャート上にあるか決定するために選択できるパラメータを有するより大きなフォーム内のサブフォームのようなものチャートフォームを使用します。アイデアは、ユーザは、パラメータを決定し、彼/彼女の好みに合わせてグラフを作成し、ボタンをクリックして、会社の背景テンプレート、何とか何とか何とか.....
とPPTスライドでそれを持つことができるということですそれは私がこれを達成するために使用する必要がオブジェクトの量の面で非常にかさばるですが、それは、動作しますので。
私は、次のような表現を使用します
like forms!frmMain.Month&*
それが保存されたクエリの数を駆動していることを私が最初に始めたときに大丈夫だったが、それはとてもうまく渡り、彼らは非常に多くの選択肢をしたい保存されたクエリへの入力値を取得するには、は、アップ/オブジェクト。私は、これはハンドルのことができるように持っている必要がありますので、チャートの異なる種類の数のチャートにはいくつかの保存されたフォームを必要とします。
SOようやく私の質問に:
私はむしろ、いくつかのVBAでその場ですべてこれを行うだろう。私は、フォーム上のリストボックス、テキストボックスを挿入する方法を知っている、と私は私ができるいくつかのVBAがある場合、私は知らない私は、VBAを使用して、テーブル/クエリから必要な値を取得するVBAでSQLを使用する方法を知っています得られたレコードから、チャートのデータ値を設定するために使用します。
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で直接データセットを変更することが可能です。私は戻って一時テーブルに結果を充填し、その上でグラフを基づかへ行ってきましたので、しかし、性能は良いようでないデータセットが非常に小さい場合しかし、あなたは確かにそれを動作させることができます(私は唯一のstackoverflowの質問を参照)。私はオフィスにいないんだけど、あなたがコードをしたい場合、私は月曜日
に投稿することができます編集:ここで私が使用した古いコードモジュールがあります。これは完全なものですが、あなたが見しようとしている重要な部分は、グラフのデータシートを開いてから、この.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
他のヒント
はこれを行う1つの非常に簡単な方法は、クエリにチャートをベースにして、クエリを更新することですたとえばます:
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