在我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角度来看，最简洁的方法是什么。使用一个主窗体作为模板，其他窗体可以作为子窗体交换进出，或者只是关闭当前窗体并在用户从下拉菜单中选择一个新的“屏幕”时打开一个新窗体。
答案 0 :(得分：1)
下面简要介绍了为某些用途“重新定位”或重新格式化表单的一种方法。关于更改VBA代码的问题，一个简单的解决方案是检查标签值或您在控件中设置的某个值，然后调用相应的VBA子例程。
我们有超过100个可用报告，每个报告都有自己的选择标准/选项，我们不想为每个报告创建唯一的过滤表单。解决方案是确定报告可用的选择选项，确定这些选项的逻辑顺序，然后创建一个表格，向用户显示选项。
首先，我们创建了表：ctlReportOptions（PK = ID，ReportName，OptionOrder） 字段：ID（Int），ReportName（文本），OptionOrder（Int），ControlName（文本），ControlTop（Int），ControlLeft（Int），SkipLabel（Y / N），ControlRecordsourc（文本） 注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
最后，每个报告都有自己的查询，可以根据此表单控件中的值进行过滤。
希望这会有所帮助。如果您对所见的任何奇怪事物感到好奇，请告诉我。 （即我们总是在代码中使用行号（我在发布前删除），这允许我们识别代码失败的确切行）