3

所以我有一些 VBA 用于获取使用表单的图表向导构建的图表，并自动将其插入到 PowerPoint 演示文稿幻灯片中。我将这些图表表单用作较大表单中的子表单，这些表单具有用户可以选择的参数来确定图表上的内容。这个想法是用户可以确定参数，根据自己的喜好构建图表，然后单击一个按钮并将其放在带有公司背景模板的 ppt 幻灯片中，等等等等......

所以它可以工作，尽管就我必须使用的对象数量而言它非常庞大。

我使用如下表达式：

like forms!frmMain.Month&*

将输入值放入已保存的查询中，这在我刚开始时很好，但它进行得非常好，他们想要这么多选项，以至于它正在推动保存的查询/对象的数量。我需要几个带有图表的已保存表格，因为我需要能够处理的不同类型图表的数量。

最后是我的问题：

我宁愿使用一些 VBA 即时完成所有这些工作。我知道如何在表单上插入列表框和文本框，我知道如何在 VBA 中使用 SQL 从使用 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")

谢谢你的帮助。为解释的长度道歉。

4

2 回答 2

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
于 2010-03-05T19:13:24.943 回答
1

正如我已经设法做到的那样，可以直接在 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
于 2010-03-05T22:25:45.473 回答