MS Access 2003 - Есть ли способ программно определить данные для диаграммы? - PullRequest
Новая
       11

MS Access 2003 - Есть ли способ программно определить данные для диаграммы?

3 голосов
/ 05 марта 2010

Итак, у меня есть несколько 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")

спасибо за вашу помощь. извиняюсь за длину объяснения.

Ответы [ 2 ]

1 голос
/ 06 марта 2010

Можно изменить набор данных непосредственно в vba, как мне удалось это сделать.Однако производительность не так хороша, поэтому я вернулся к заполнению результатов во временной таблице и на основании этого построил график (см. Мой единственный заданный вопрос stackoverflow), однако, если набор данных достаточно мал, вы, безусловно, можете заставить его работать.Я не в офисе, но если вы хотите код, я могу опубликовать в понедельник

РЕДАКТИРОВАТЬ: вот старый модуль кода, который я использовал.Это полная вещь, но ключевая часть, на которую вы собираетесь смотреть, это часть об открытии таблицы данных графика и последующем изменении его значения следующим образом .cells (1,0) = "badger".

Я неизбежно сбросил этот метод и использовал временную таблицу, так как в моем приложении график довольно много перерисовывается, и мне нужно было выбрать самый быстрый из возможных методов, чтобы дать ему ощущение «реального времени», но это может быть простоотлично для ваших нужд 

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 голос
/ 05 марта 2010

Один из очень простых способов сделать это - основать диаграмму на запросе и обновить запрос, например: 

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
...