MS Access 2003 - هل هناك طريقة لتحديد البيانات برمجيًا للرسم البياني؟

Question

لذلك لدي بعض 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")

شكرا لمساعدتك. يعتذر عن طول التفسير.

Answer 1

من الممكن تغيير مجموعة البيانات مباشرة في VBA حيث تمكنت من القيام بذلك. ومع ذلك ، فإن الأداء ليس جيدًا ، لذا عدت إلى ملء النتائج على جدول مؤقت ووضع الرسم البياني على ذلك (انظر سؤال Stackoverflow الخاص بي الوحيد) ولكن إذا كانت مجموعة البيانات صغيرة جدًا ، فيمكنك بالتأكيد جعلها تعمل. أنا لست في المكتب ولكن إذا كنت تريد رمزًا يمكنني نشره يوم الاثنين

تحرير: هنا هي وحدة الكود القديم الذي استخدمته. هذا هو الشيء الكامل ، لكن الجزء الرئيسي الذي ستنظر إليه هو الجزء حول فتح ورقة البيانات للرسم البياني ثم تغيير قيمة ذلك مثل هذا .kells (1،0) = "بادجر".

لقد ألقيت هذه الطريقة بصراحة وذهبت مع جدول مؤقت كما في تطبيقي ، يتم إعادة رسم الرسم البياني كثيرًا وكنت بحاجة إلى الذهاب لأسرع طريقة ممكنة لإعطاء "الوقت الحقيقي" الاحتياجات

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

Answer 2

إحدى الطرق السهلة للقيام بذلك هي بناء المخطط على الاستعلام وتحديث الاستعلام ، على سبيل المثال:

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