我应该在一个表单上重新使用子表单控件还是只创建多个表单？

Question

在我有 65 人的办公室中，我想用一个 .accdb 文件为所有员工创建一个“门户”。它将允许每个员工从下拉菜单中导航到新的“屏幕”。

我应该使用带有即插即用子表单控件的单个表单来集中 VBA 代码，还是应该只使用不同的表单？

我认为拥有一种带有即插即用子表单控件的表单会很好。当员工选择一个新的“屏幕”时，VBA只需设置每个子窗体控件的SourceObject属性，然后根据所选“屏幕”的布局重新排列子窗体。

例如，我们目前使用几个 Access 数据库表单来输入和查看我们在工作流系统中发现的错误。因此，在这种情况下，要查看错误，我只想说

SubForm1.SourceObject = "Form.ErrorCriteria"
SubForm2.SourceObject = "Form.ErrorResults"

然后我将它们移动到位（这些值将根据所选的“屏幕”动态拉出）：

SubForm1.Move WindowWidth * 0.05, WindowHeight * 0.05, WindowWidth * 0.9, WindowHeight * 0.2
SubForm2.Move WindowWidth * 0.05, WindowHeight * 0.25, WindowWidth * 0.9, WindowHeight * 0.65

因此，这会在表单上创建一个小的标题部分 (SubForm1)，我可以在其中选择要查看的错误的标准（数据范围、哪个团队犯了错误等），然后我可以查看错误在标题下方更大的部分 (SubForm2) 中保存数据表和结果。

我可以将事件从现在绑定到子表单控件的ErrorCriteria 和ErrorResults 表单传播到主表单。这将帮助我使用 here 描述的 VBA 的基本 MVC 设计模式。我可以将主窗体视为视图，即使该视图的某些部分隐藏在子窗体控件中。控制器只需要知道那个视图。

当用户从下拉菜单中选择一个新的“屏幕”时，我的问题就出现了。我认为重新调整子表单控件的用途会很好，如下所示：

SubForm1.SourceObject = "Form.WarehouseCriteria"
SubForm2.SourceObject = "Form.InventoryResults"

然后只需将这些子表单移动/调整大小到“库存”屏幕的适当布局即可。

这种方法似乎使我认为用户界面设计更清晰，因为您基本上只需要处理一个充当模板的主表单，然后将值（SourceObject 属性）插入该模板.

但是每次我们更改“屏幕”时，我们都会在幕后拥有一个完全不同的“模型”，并且根据 MVC 设计模式也有一个新的“视图”。我想知道这是否会使幕后的 MVC VBA 代码混乱，或者 VBA 代码本身是否也可以模块化（可能使用接口）以使其与用户界面一样具有适应性。

从用户界面的角度和 VBA 的角度来看，最简洁的方法是什么。使用一个主表单作为模板，其他表单可以作为子表单交换进出，或者当用户从下拉菜单中选择一个新的“屏幕”时，关闭当前表单并打开一个新表单。

Answer 1

下面是对“重新调整用途”或重新格式化表单以用于多种用途的一种方法的简要说明。关于更改 VBA 代码的问题，一个简单的解决方案是检查标签值或您在控件中设置的某个值，然后调用适当的 VBA 子例程。

我们有超过 100 份报告可用，每份报告都有自己的选择标准/选项，我们不想为每份报告创建一个独特的过滤器表单。解决方案是通过报告确定可用的选择选项，确定这些选项的逻辑顺序，然后创建一个表格，将选项呈现给用户。

首先，我们创建了表：ctlReportOptions (PK = ID, ReportName, OptionOrder) 字段：ID (Int)、ReportName (text)、OptionOrder (Int)、ControlName (text)、ControlTop (Int)、ControlLeft (Int)、SkipLabel (Y/N)、ControlRecordsourc(text) 注 1：ID 不是自动编号。

接下来，我们填充了定义用户将看到的视图的记录。 注意 2：使用 ID 为零，我们为报告中的每个字段创建记录，以便我们可以随时为开发人员重绘。

然后我们创建表单并为每个可能的过滤器放置控件。 我们将“默认值”属性设置为我们的默认值。

一些控件： ComboBox 选择报告名称。为 Change 事件添加代码如下：

Private Sub cboChooseReport_Change()
Dim strSQL      As String
Dim rs          As ADODB.recordSet
Dim i           As Integer
Dim iTop        As Integer
Dim iLeft       As Integer
Dim iLblTop     As Integer
Dim iLblLeft    As Integer
Dim iLblWidth   As Integer
Dim iTab        As Integer
Dim strLabel    As String

    On Error GoTo Error_Trap
    ' Select only optional controls (ID <> 0); skip cotrols always present.
    strSQL = "SELECT ctlRptOpt.ControlName, 'lbl' & Mid([ControlName],4,99) AS LabelName, SkipLabel " & _
                "From ctlRptOpt WHERE (((ctlRptOpt.ID)<>0)) " & _
                "GROUP BY ctlRptOpt.ControlName, 'lbl' & Mid([ControlName],4,99), SkipLabel;"
    Set rs = New ADODB.recordSet
    rs.Open strSQL, CurrentProject.Connection, adOpenDynamic

    Do While Not rs.EOF
        Me(rs!ControlName).Visible = False      ' Hide control
        If rs!skiplabel = False Then            ' Hide Label if necessary
            Me(rs!LabelName).Visible = False
        End If
        rs.MoveNext
    Loop
    rs.Close

    iTop = 0
    iTab = 0

    ' Get list of controls used by this report; order by desired sequence.
    strSQL = "select * from ctlRptOpt " & _
                "where [ID] = " & Me.cboChooseReport.Column(3) & _
                " order by OptionOrder;"
    Set rs = New ADODB.recordSet
    rs.Open strSQL, CurrentProject.Connection, adOpenDynamic

    If rs.EOF Then      ' No options needed
        Me.cmdShowQuery.Visible = True
        Me.lblReportCriteria.Visible = False
        Me.cmdShowQuery.left = 2000
        Me.cmdShowQuery.top = 1500
        Me.cmdShowQuery.TabIndex = 1
        Me.cmdReset.Visible = False
        rs.Close
        Set rs = Nothing
        GoTo Proc_Exit              ' Exit
    End If

    ' Setup the display of controls.
    Me.lblReportCriteria.Visible = True
    Do While Not rs.EOF
        If rs!skiplabel = False Then
            strLabel = "lbl" & Mid(rs!ControlName, 4)
            iLblWidth = Me.Controls(strLabel).Width
            Me(strLabel).top = rs!ControlTop
            Me(strLabel).left = rs!ControlLeft - (Me(strLabel).Width + 50)
            Me(strLabel).Visible = True
        End If

        iTab = iTab + 1         ' Set new Tab Order for the controls
        Me(rs!ControlName).top = rs!ControlTop
        Me(rs!ControlName).left = rs!ControlLeft
        Me(rs!ControlName).Visible = True
        If left(rs!ControlName, 3) <> "lbl" Then
            Me(rs!ControlName).TabIndex = iTab
        End If

        If Me(rs!ControlName).top >= iTop Then
            iTop = rs!ControlTop + Me(rs!ControlName).Height          ' Save last one
        End If

        ' If not a label and not a 'cmd', it's a filter! Set a default.
        If left(rs!ControlName, 3) <> "lbl" And left(rs!ControlName, 3) <> "cmd" Then
            If Me(rs!ControlName).DefaultValue = "=""*""" Then
'                Me(rs!ControlName) = "*"
            ElseIf left(Me(rs!ControlName).DefaultValue, 2) = "=#" And right(Me(rs!ControlName).DefaultValue, 1) = "#" Then
                i = Len(Me(rs!ControlName).DefaultValue)
'                Me(rs!ControlName) = Mid(Me(rs!ControlName).DefaultValue, 3, i - 3)
            ElseIf Me(rs!ControlName).DefaultValue = "True" Then
'                Me(rs!ControlName) = True
            ElseIf Me(rs!ControlName).DefaultValue = "False" Then
'                Me(rs!ControlName) = False
            End If
        Else
            If Me(rs!ControlName).top + Me(rs!ControlName).Height >= iTop Then
                iTop = rs!ControlTop + Me(rs!ControlName).Height          ' Save last one
            End If
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing

    If Me.cboChooseReport.Column(1) <> "rptInventoryByDate" Then        ' It's special
        Me.cmdShowQuery.Visible = True
        Me.cmdShowQuery.left = 2000
        Me.cmdShowQuery.top = iTop + 300
        iTab = iTab + 1
        Me.cmdShowQuery.TabIndex = iTab
    Else
        Me.cmdShowQuery.Visible = False
    End If
    Me.cmdReset.Visible = True
    Me.cmdReset.left = 5000
    Me.cmdReset.top = iTop + 300
    Me.cmdReset.TabIndex = iTab + 1

Proc_Exit:
    Exit Sub
Error_Trap:
    Err.Source = "Form_frmReportChooser: cboChooseReport_Change  at Line: " & Erl
    DocAndShowError     ' Save error to database for analysis, then display to user.
    Resume Proc_Exit    ' Exit code.
    Resume Next         ' All resumption if debugging.
    Resume
End Sub

lblReportCriteria：我们展示了最后一组过滤器，因此当用户抱怨报告中没有显示任何内容时，我们要求他们向我们发送屏幕打印。我们还将此文本传递给报告，并将其作为页脚打印在最后一页。

cmdReset：将所有控件重置为默认值。

cmdShowQuery：执行报表的运行

Private Sub cmdShowQuery_Click()    
Dim qdfDelReport101             As ADODB.Command
Dim qdfAppReport101             As ADODB.Command
Dim qdfDelReport102             As ADODB.Command
Dim qdfAppReport102             As ADODB.Command
Dim qryBase                     As ADODB.Command
Dim strQueryName                As String
Dim strAny_Open_Reports         As String
Dim strOpen_Report              As String
Dim qdfVendorsInfo              As ADODB.Command
Dim rsVendorName                As ADODB.recordSet
Dim strVendorName               As String
Dim rsrpqFormVendorsInfo        As ADODB.recordSet

    On Error GoTo Error_Trap
    If Not IsNull(Me.cboChooseReport.value) And Me.cboChooseReport.value <> " " Then
        strAny_Open_Reports = Any_Open_Reports()
        If Len(strAny_Open_Reports) = 0 Then

            If Me.cboChooseReport.value = "rptAAA" Then
                BuildReportCriteria                 '
                If Me.chkBankBal = True Then
                    DoCmd.OpenReport "rptAAA_Opt1", acViewPreview
                Else
                    DoCmd.OpenReport "rptAAA_Opt2", acViewPreview
                End If
            ElseIf Me.cboChooseReport.value = "rptBBB" Then
                If IsNull(Me.txtFromDate) Or Not IsDate(Me.txtFromDate) Then
                    MsgBox "You must enter a valid From Date", vbOKOnly, "Invalid Date"
                    Exit Sub
                End If
                If IsNull(Me.txtToDate) Or Not IsDate(Me.txtToDate) Then
                    MsgBox "You must enter a valid To Date", vbOKOnly, "Invalid Date"
                    Exit Sub
                End If

                Me.txtStartDate = Me.txtFromDate
                Me.txtEndDate = Me.txtToDate
                DoCmd.OpenReport Me.cboChooseReport.value, acViewPreview
            ElseIf Me.cboChooseReport.value = "rptCCC" Then
                If Me.txtVendorName = "*" Then
                    gvstr_VendorName = "*"
                Else
                    Set rsVendorName = New ADODB.recordSet
                    rsVendorName.Open "selVendorName", gv_DBS_Local, adOpenDynamic

                    Set qdfVendorsInfo = New ADODB.Command
                    qdfVendorsInfo.ActiveConnection = gv_DBS_SQLServer
                    qdfVendorsInfo.CommandText = ("qryVendorsInfo")
                    qdfVendorsInfo.CommandType = adCmdStoredProc
                    strVendorName = rsVendorName("VendorName")
                    gvstr_VendorName = strVendorName
                End If
                DoCmd.OpenReport "rptFormVendorReport", acViewPreview
            Else
                BuildReportCriteria
                If Me.cboChooseReport.value = "rptXXXXXX" Then
                ElseIf Me.cboChooseReport.value = "rptyyyy" Then
                    On Error Resume Next         ' All resumption if debugging.
                    DoCmd.DeleteObject acTable, "temp_xxxx"
                    On Error GoTo Error_Trap
                    Set qryBase = New ADODB.Command
                    qryBase.ActiveConnection = gv_DBS_Local
                    qryBase.CommandText = ("mtseldata...")
                    qryBase.CommandType = adCmdStoredProc
                    qryBase.Execute
                End If
                DoCmd.Hourglass False
                DoCmd.OpenReport Me.cboChooseReport.value, acViewPreview
            End If
        Else
            MsgBox "You cannot open this form/report because you already have a form/report(s) open: " & _
                    vbCrLf & strAny_Open_Reports & _
                    vbCrLf & "Please close the open form/report(s) before continuing."

             strOpen_Report = Open_Report
             DoCmd.SelectObject acReport, strOpen_Report
             DoCmd.ShowToolbar "tbForPost"
        End If
    Else
         MsgBox "Please Choose Report", vbExclamation, "Choose Report"
    End If

    Exit Sub

Error_Trap:
    Err.Source = "Form_frmReportChooser: cmdShowQuery_Click - Report: " & Nz(Me.cboChooseReport.value) & "    at Line: " & Erl
    If Err.Number = 2501 Then   ' MsgBox "You chose not to open this report.", vbOKOnly, "Report cancelled"
        Exit Sub
    ElseIf Err.Number = 0 Or Err.Number = 7874 Then
        Resume Next         ' All resumption if debugging.

    ElseIf Err.Number = 3146 Then   ' ODBC -- call failed -- can have multiple errors
Dim errLoop     As Error
Dim strError    As String
Dim Errs1       As Errors

    ' Enumerate Errors collection and display properties of each Error object.
    i = 1
      Set Errs1 = gv_DBS_SQLServer.Errors
        Err.Description = Err.Description & "; Err.Count = " & gv_DBS_SQLServer.Errors.Count & "; "
        For Each errLoop In Errs1
            With errLoop
                Err.Description = Err.Description & "Error #" & i & ":" & " ADO Error#" & .Number & _
                        " Description= " & .Description
                i = i + 1
            End With
        Next

    End If
    DocAndShowError     ' Save error to database for analysis, then display to user.
    Exit Sub
    Resume Next         ' All resumption if debugging.
    Resume
End Sub

用于构建显示所有选择标准的字符串的功能：

Function BuildReportCriteria()
Dim frmMe           As Form
Dim ctlEach         As Control
Dim strCriteria     As String
Dim prp             As Property
Dim strSQL          As String
Dim rs              As ADODB.recordSet

    On Error GoTo Error_Trap

    strSQL = "select * from ctlRptOpt " & _
                "where ID = " & Me.cboChooseReport.Column(3) & _
                " order by OptionOrder;"
    Set rs = New ADODB.recordSet
    rs.Open strSQL, CurrentProject.Connection, adOpenDynamic

    If rs.EOF Then
        strCriteria = "     Report Criteria:  None"
    Else
        strCriteria = "     Report Criteria:  "
    End If

    Do While Not rs.EOF
        Set ctlEach = Me.Controls(rs!ControlName)
        If ctlEach.ControlType = acTextBox Or ctlEach.ControlType = acComboBox Then
            If ctlEach.value <> "*" And ctlEach.Name <> "cboChooseReport" And ctlEach.Name <> "cboLocCountry" Then
                strCriteria = strCriteria & ctlEach.Tag & " = " & ctlEach.value & " , "
            End If
         End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing

    If Me.chkOblBal = -1 Then
        strCriteria = strCriteria & "Non-zero balances only = Yes"
    Else
    'return string with all choosen criteria and remove last " , " from the end of string
        strCriteria = left$(strCriteria, Len(strCriteria) - 3)
    End If
    fvstr_ReportCriteria = strCriteria

    Set ctlEach = Nothing

    Exit Function
Error_Trap:
    If Err.Number = 2447 Then
        Resume Next         ' All resumption if debugging.
    End If
    Err.Source = "Form_frmReportChooser: BuildReportCriteria  at Line: " & Erl
    DocAndShowError     ' Save error to database for analysis, then display to user.
    Exit Function
    Resume Next         ' All resumption if debugging.
End Function

最后，每个报表都有自己的查询，该查询将根据此表单上控件中的值进行过滤。

希望这会有所帮助。如果你对你看到的任何奇怪的东西感到好奇，请告诉我。 （即我们总是在代码中使用行号（我在发布之前删除了），这使我们能够识别代码失败的确切行）