MS Access 2003 - Gibt es eine Möglichkeit, um programmatisch die Daten für ein Diagramm zu definieren?

StackOverflow https://stackoverflow.com/questions/2388691

Frage

Also ich einige VBA habe für Diagramme gebaut mit dem Formular der Übersicht unter Assistenten und in automatisch Folien Powerpoint-Präsentation einfügen. Ich benutze diese Chart-Formulare als Unterformen in einem größeren Formen, die Parameter hat der Benutzer auswählen kann, um zu bestimmen, was auf der Karte ist. Die Idee ist, dass der Benutzer die Parameter bestimmen kann, baut das Diagramm zu ihrem / seinen Geschmack, und klicken Sie auf eine Schaltfläche, und hat es in einer ppt Folie mit dem Hintergrund Vorlage des Unternehmens, bla bla bla .....

So funktioniert es, wenn es in Bezug auf die Menge von Objekten sehr sperrig ist, ich habe zu verwenden, um dies zu erreichen.

Ich benutze Ausdrücke wie folgt: 

like forms!frmMain.Month&*

die Eingabewerte in die gespeicherten Abfragen zu bekommen, was in Ordnung war, als ich zum ersten Mal gestartet, aber es ging so weit über, und sie wollen so viele Optionen, dass sie die Anzahl der gespeicherten Abfragen fahren / Objekte auf. Ich brauche mehrere gespeicherten Formulare mit Diagrammen aufgrund der Anzahl der verschiedenen Arten von Diagrammen Ich muss das Handle der Lage sein, haben.

SO ENDLICH ZU MEINER FRAGE:

Ich würde viel lieber tut dies alles im Fluge mit einigen VBA. Ich weiß, wie Listenfelder einfügen und Textfelder auf einem Formular, und ich weiß, wie SQL in VBA verwenden, um die Werte zu erhalten ich aus Tabellen / Abfragen mit VBA will, ich weiß nur nicht, ob es einig vba ich kann ist verwenden, um die Datenwerte des Diagramme aus einem resultierenden Cord-set zu setzen: 

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")

Danke für Ihre Hilfe. Entschuldigung für die Länge der Erklärung.

War es hilfreich?

Lösung

Es ist möglich, den Datensatz direkt in vba zu ändern, wie ich es geschafft haben, es zu tun. Allerdings ist die Leistung nicht so gut, also ich, dass die Ergebnisse in eine temporäre Tabelle zu füllen und der Orientierung der Grafik (siehe meine einzige fragte Stackoverflow Frage) ging zurück aber wenn der Datensatz recht klein ist, dann können Sie sicher es funktioniert. Ich bin nicht im Büro, aber wenn Sie Code wollen, kann ich poste am Montag

EDIT: Hier ist das alte Code-Modul I verwendet. Dies ist die vollständige Sache, aber der Schlüssel Teil Sie betrachtend werden werden wird der Teil über das Datenblatt des Diagramms zu öffnen und dann den Wert es so .Cells Wechsel (1,0) = „Dachs“.

ich abgeladen enevtly diese Methode und ging mit einer temporären Tabelle wie in meinem app die Grafik ziemlich viel ist neu gezeichnet und ich brauchte für die schnellstmögliche Methode zu gehen, um ein „Echtzeit“ Gefühl zu ihm zu geben, aber es könnte sein, gut für Ihre Bedürfnisse 

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

Andere Tipps

Eine sehr einfache Möglichkeit, dies zu tun, ist das Diagramm auf einer Abfrage zu stützen und die Abfrage zu aktualisieren, zum Beispiel: 

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
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top