我应该 re-purpose 在一个表单上创建子表单控件还是只创建多个表单？
Should I re-purpose subform controls on one form or just create multiple forms?
在我 65 人的办公室里，我想用一个 .accdb 文件为所有员工创建一个 "portal"。它将允许每个员工从下拉菜单导航到新的 "screen"。
我应该使用带有 plug-and-play 子表单控件的单一表单来集中 VBA 代码，还是应该使用不同的表单？
我认为如果有一个带有 plug-and-play 子表单控件的表单会很好。当员工 select 是一个新的 "screen" 时，VBA 只是设置每个子表单控件的 SourceObject 属性 然后 re-arranges 子表单基于selected "screen".
的布局
例如，我们目前使用几个 Access 数据库表单来输入和查看我们在工作流系统中发现的错误。所以在这种情况下，要查看错误，我只想说
SubForm1.SourceObject = "Form.ErrorCriteria"
SubForm2.SourceObject = "Form.ErrorResults"
然后我会将它们移动到位（这些值将根据 "screen" selected 动态拉取）：
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
因此，这会在表单上创建一个小的 header 部分 (SubForm1)，我可以在其中 select 我想查看的错误标准（数据范围，哪个团队提交的错误等），然后我可以在 header (SubForm2) 下面的更大部分中查看错误，该部分包含数据表和结果。
我可以将事件从现在绑定到子窗体控件的 ErrorCriteria 和 ErrorResults 窗体传播到主窗体。这将帮助我使用 VBA 描述的 here 的基本 MVC 设计模式。我可以将主窗体视为视图，即使该视图的某些部分隐藏在子窗体控件中。控制器只需要知道那个视图。
当用户从下拉菜单中 select 新 "screen" 时，我的问题就来了。我认为只 re-purpose 子表单控件会很好，像这样：
SubForm1.SourceObject = "Form.WarehouseCriteria"
SubForm2.SourceObject = "Form.InventoryResults"
然后只是 move/resize 那些子表单到 "Inventory" 屏幕的适当布局。
在我看来，这种方法似乎使用户界面设计更清晰，因为您基本上只需要处理一个用作模板的主窗体，然后插入值（SourceObject 属性) 到该模板中。
但是每次我们更改 "screen" 时，我们在幕后都有一个完全不同的 "Model"，并且根据 MVC 设计模式还有一个新的 "View"。我想知道这是否会使幕后的 MVC VBA 代码变得混乱，或者 VBA 代码本身是否也可以模块化（可能使用接口）以使其与用户界面一样具有适应性。
从用户界面的角度和 VBA 的角度来看，最简洁的方法是什么。使用一个主表单作为模板，其他表单可以作为子表单换入和换出，或者当用户 select 从下拉菜单中选择一个新的 "screen" 时关闭当前表单并打开一个新表单。 =21=]
下面简要描述了一种 'repurpose' 或重新格式化表单以供多种用途的方法。关于更改 VBA 代码的问题，一个简单的解决方案是检查标签值或您在控件中设置的某些值，然后调用适当的 VBA 子例程。
我们有 100 多个报告可用，每个报告都有自己的 selection criteria/options，我们不想为每个报告创建唯一的过滤器表单。解决方案是确定报告可用的 selection 选项，确定这些选项的逻辑顺序，然后创建一个 table 来向用户显示这些选项。
首先，我们创建了table：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，我们为报表上的每个字段创建了记录，因此我们可以随时为开发人员重新绘制。
然后我们创建了表单并为每个可能的过滤器放置了控件。
我们将 'Default Value' 属性 设置为默认值。
部分控件：
ComboBox 到 select 报表名称。 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
构建显示所有 select离子标准的字符串的函数：
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
最后，每个报告都有自己的查询，该查询将根据此表单控件中的值进行过滤。
希望这对您有所帮助。如果你对你看到的任何奇怪的东西感到好奇，请告诉我。 （即我们总是在代码中使用行号（我在发布前删除了），这使我们能够识别代码失败的确切行）
在我 65 人的办公室里，我想用一个 .accdb 文件为所有员工创建一个 "portal"。它将允许每个员工从下拉菜单导航到新的 "screen"。
我应该使用带有 plug-and-play 子表单控件的单一表单来集中 VBA 代码，还是应该使用不同的表单？
我认为如果有一个带有 plug-and-play 子表单控件的表单会很好。当员工 select 是一个新的 "screen" 时，VBA 只是设置每个子表单控件的 SourceObject 属性 然后 re-arranges 子表单基于selected "screen".
例如，我们目前使用几个 Access 数据库表单来输入和查看我们在工作流系统中发现的错误。所以在这种情况下，要查看错误，我只想说
SubForm1.SourceObject = "Form.ErrorCriteria"
SubForm2.SourceObject = "Form.ErrorResults"
然后我会将它们移动到位（这些值将根据 "screen" selected 动态拉取）：
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
因此，这会在表单上创建一个小的 header 部分 (SubForm1)，我可以在其中 select 我想查看的错误标准（数据范围，哪个团队提交的错误等），然后我可以在 header (SubForm2) 下面的更大部分中查看错误，该部分包含数据表和结果。
我可以将事件从现在绑定到子窗体控件的 ErrorCriteria 和 ErrorResults 窗体传播到主窗体。这将帮助我使用 VBA 描述的 here 的基本 MVC 设计模式。我可以将主窗体视为视图，即使该视图的某些部分隐藏在子窗体控件中。控制器只需要知道那个视图。
当用户从下拉菜单中 select 新 "screen" 时，我的问题就来了。我认为只 re-purpose 子表单控件会很好，像这样：
SubForm1.SourceObject = "Form.WarehouseCriteria"
SubForm2.SourceObject = "Form.InventoryResults"
然后只是 move/resize 那些子表单到 "Inventory" 屏幕的适当布局。
在我看来，这种方法似乎使用户界面设计更清晰，因为您基本上只需要处理一个用作模板的主窗体，然后插入值（SourceObject 属性) 到该模板中。
但是每次我们更改 "screen" 时，我们在幕后都有一个完全不同的 "Model"，并且根据 MVC 设计模式还有一个新的 "View"。我想知道这是否会使幕后的 MVC VBA 代码变得混乱，或者 VBA 代码本身是否也可以模块化（可能使用接口）以使其与用户界面一样具有适应性。
从用户界面的角度和 VBA 的角度来看，最简洁的方法是什么。使用一个主表单作为模板，其他表单可以作为子表单换入和换出，或者当用户 select 从下拉菜单中选择一个新的 "screen" 时关闭当前表单并打开一个新表单。 =21=]
下面简要描述了一种 'repurpose' 或重新格式化表单以供多种用途的方法。关于更改 VBA 代码的问题，一个简单的解决方案是检查标签值或您在控件中设置的某些值，然后调用适当的 VBA 子例程。
我们有 100 多个报告可用，每个报告都有自己的 selection criteria/options，我们不想为每个报告创建唯一的过滤器表单。解决方案是确定报告可用的 selection 选项，确定这些选项的逻辑顺序，然后创建一个 table 来向用户显示这些选项。
首先，我们创建了table：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，我们为报表上的每个字段创建了记录，因此我们可以随时为开发人员重新绘制。
然后我们创建了表单并为每个可能的过滤器放置了控件。 我们将 'Default Value' 属性 设置为默认值。
部分控件： ComboBox 到 select 报表名称。 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
构建显示所有 select离子标准的字符串的函数：
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
最后，每个报告都有自己的查询，该查询将根据此表单控件中的值进行过滤。
希望这对您有所帮助。如果你对你看到的任何奇怪的东西感到好奇，请告诉我。 （即我们总是在代码中使用行号（我在发布前删除了），这使我们能够识别代码失败的确切行）