MS Access 2003 - Есть ли способ программно определить данные для диаграммы?
https://stackoverflow.com/questions/2388691
-
24-09-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianВопрос
Поэтому у меня есть несколько VBA для принятия графиков, построенных с мастером диаграммы формы, и автоматически вставляя его в слайды презентации PowerPoint. Я использую эти формы диаграммы в качестве дополнительных форм в более крупных формах, которые имеют параметры, пользователь может выбрать, чтобы определить, что на графике. Идея состоит в том, что пользователь может определить параметр, построить график к его / ее понравинию и щелкнуть кнопку и иметь ее в PPT Slide с фоновым шаблоном компании Blah Blah Blah .....
Так что это работает, хотя это очень громоздкое с точки зрения количества объектов, которые я должен использовать для достижения этого.
Я использую выражения, такие как следующее:
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, так как мне удалось сделать это. Однако производительность не так хороша, поэтому я вернулся к заполнению результатов в таблицу TEMP и навязывает график на этом (см. Мой только заданный вопрос Stackoverflow) Однако, если набор данных довольно маленький, то, безусловно, вы можете сделать это работать. Я не в офисе, но если вы хотите, чтобы код я могу опубликовать в понедельник
Редактировать: вот старый код код, который я использовал. Это полное, но ключевая часть, на которую вы смотрите, - это часть о открытии таблицы графика, а затем изменив значение, подобное этому .Cells (1,0) = «Badger».
Я EneVtly бросил этот метод и пошел с таблицей TEMP, так как в моем приложении график довольно много, и мне нужно было пойти на самый быстрый возможный метод, чтобы дать ему «в реальном времени», но это может быть просто хорошо для вашего потребности
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
