我正在尝试创建一个自动化仪表板，用户可以在其中选择要在Excel中运行的报告类型，这将影响单元格中影响MS Access中查询的参数类型（使用MS Query函数） ）。
我的问题是，我不能为我的生活弄清楚如何使这项工作。例如，Access中的数据表具有以下内容：
Col1 Col2 Col3 Col4
Date Apples Pumpkin Cars
Oranges Potato Trucks
Grapes
我希望能够使用以下参数运行查询，以便只返回以下值：
日期苹果橘子南瓜土豆车
但是，有人选择的下一个报告可能包含以下内容：
日期苹果橘子葡萄南瓜汽车
任何人都知道如何才能使这项工作成功？基本上，如果未选择参数，则返回表中的所有值。
我想我已经成功解释了这个问题！
答案 0 :(得分：0)
这将描述一种提供一种表单（frmReportChooser）的简单方法，该表单允许用户选择任何报告。选择后，将向用户显示用于过滤该报告的自定义控件列表，并允许用户为任何过滤器组合设置值。
以下代码摘自我们使用的表格，并删除了机密名称/信息。
如果您有任何疑问或问题，请与我联系。
此代码使用以下两个表：
= [Forms]！[frmReportChooser]！[txtFiscalYear]（将具有默认的'*'或您选择/输入的值。
表单：frmReportChooser主子例程
当用户从comboBox' cboChooseReport '中选择报告时
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
1000 On Error GoTo Error_Trap
1020 strSQL = "SELECT ctrlReportOptions.ControlName, 'lbl' & Mid([ControlName],4,99) AS LabelName, SkipLabel " & _
"From ctrlReportOptions WHERE (((ctrlReportOptions.ID)<>0)) " & _
"GROUP BY ctrlReportOptions.ControlName, 'lbl' & Mid([ControlName],4,99), SkipLabel;"
1080 Set rs = New ADODB.Recordset
1100 rs.Open strSQL, CurrentProject.Connection, adOpenDynamic
1120 Do While Not rs.EOF
1140 Me(rs!ControlName).visible = False
1160 If rs!skiplabel = False Then
1180 Me(rs!LabelName).visible = False
1200 End If
1220 rs.MoveNext
1240 Loop
1260 rs.Close
1280 iTop = 0
1300 iTab = 0
1301 If IsNull(Me.cboChooseReport.Column(3)) Or Me.cboChooseReport.Column(3) = "" Then
1302 MsgBox "The field where you select a report is either empty or is missing an internal ID number." & _
vbCrLf & vbCrLf & _
"Please be sure you have selected a report.", vbOKOnly, "Missing Parameter"
1303 GoTo Proc_Exit
1305 End If
1320 strSQL = "select * from ctrlReportOptions " & _
"where [ID] = " & Me.cboChooseReport.Column(3) & _
" order by OptionOrder;"
1380 Set rs = New ADODB.Recordset
1400 rs.Open strSQL, CurrentProject.Connection, adOpenDynamic
1420 If rs.EOF Then
1440 Me.cmdShowQuery.visible = True
1460 Me.lblReportCriteria.visible = False
1480 Me.cmdShowQuery.Left = 2000
1500 Me.cmdShowQuery.Top = 1500
1520 Me.cmdShowQuery.TabIndex = 1
1540 Me.cmdReset.visible = False
1560 rs.Close
1580 Set rs = Nothing
1600 GoTo Proc_Exit
1620 End If
1640 Me.lblReportCriteria.visible = True
1660 Do While Not rs.EOF
1680 If rs!skiplabel = False Then
1700 strLabel = "lbl" & Mid(rs!ControlName, 4)
1720 iLblWidth = Me.Controls(strLabel).Width
1740 Me(strLabel).Top = rs!ControlTop
1760 Me(strLabel).Left = rs!ControlLeft - (Me(strLabel).Width + 50)
1780 Me(strLabel).visible = True
1820 End If
1840 iTab = iTab + 1
1860 Me(rs!ControlName).Top = rs!ControlTop
1880 Me(rs!ControlName).Left = rs!ControlLeft
1900 Me(rs!ControlName).visible = True
1920 If Left(rs!ControlName, 3) <> "lbl" Then
1940 Me(rs!ControlName).TabIndex = iTab
1960 End If
1980 If Me(rs!ControlName).Top >= iTop Then
2000 iTop = rs!ControlTop + Me(rs!ControlName).Height ' Save last one
2020 End If
2040 If Left(rs!ControlName, 3) <> "lbl" And Left(rs!ControlName, 3) <> "cmd" Then
2060 If Me(rs!ControlName).DefaultValue = "=""*""" Then
'
2080 ElseIf Left(Me(rs!ControlName).DefaultValue, 2) = "=#" And Right(Me(rs!ControlName).DefaultValue, 1) = "#" Then
2100 i = Len(Me(rs!ControlName).DefaultValue)
'
2120 ElseIf Me(rs!ControlName).DefaultValue = "True" Then
'
2140 ElseIf Me(rs!ControlName).DefaultValue = "False" Then
'
2160 End If
2180 Else
2200 If Me(rs!ControlName).Top + Me(rs!ControlName).Height >= iTop Then
2220 iTop = rs!ControlTop + Me(rs!ControlName).Height ' Save last one
2240 End If
2260 End If
2280 rs.MoveNext
2300 Loop
2320 rs.Close
2340 Set rs = Nothing
2360 If Me.cboChooseReport.Column(1) <> "<<my special report>>" Then
2380 Me.cmdShowQuery.visible = True
2400 Me.cmdShowQuery.Left = 2000
2420 Me.cmdShowQuery.Top = iTop + 300
2440 iTab = iTab + 1
2460 Me.cmdShowQuery.TabIndex = iTab
2480 Else
2500 Me.cmdShowQuery.visible = False
2520 End If
2540 Me.cmdReset.visible = True
2560 Me.cmdReset.Left = 5000
2580 Me.cmdReset.Top = iTop + 300
2600 Me.cmdReset.TabIndex = iTab + 1
2620 Proc_Exit:
2640 Exit Sub
2660 Error_Trap:
2680 Err.Source = "Form_frmReportChooser: cboChooseReport_Change at Line: " & Erl
2700 DocAndShowError
2720 Resume Proc_Exit
2740 Resume Next
2760 Resume
End Sub
Private Sub cmdReset_Click()
1000 On Error GoTo Error_Trap
1020 Me.cboFiscalYear.value = Eval(Mid$(Me. cboFiscalYear.DefaultValue, 2))
1040 Me.cboPart.value = Eval(Mid$(Me.cboPart.DefaultValue, 2))
1220 Me.chkYesNo = False
. . .
1560 Me.txtStartDate.value = Eval(Mid$(Me. txtStartDate.DefaultValue, 2, 10))
. . .
1660 Me.Requery
1680 Me.Refresh
1700 Proc_Exit:
1720 Exit Sub
1740 Error_Trap:
1760 Err.Source = "Form_frmReportChooser: cmdReset_Click at Line: " & Erl
1780 DocAndShowError
1800 Resume Proc_Exit
1820 Resume Next
End Sub
当用户单击命令按钮以生成报告时： Private Sub cmdShowQuery_Click（）
Dim qryBase As ADODB.Command
Dim strQueryName As String
Dim strAny_Open_Reports As String
Dim strOpen_Report As String
1000 On Error GoTo Error_Trap
1020 If Not IsNull(Me.cboChooseReport.value) And Me.cboChooseReport.value <> " " Then
1040 strAny_Open_Reports = Any_Open_Reports() ' Check if any reports already open
1060 If Len(strAny_Open_Reports) = 0 Then
1080 If Me.cboChooseReport.value = "<your report name>" Then
1090 BuildReportCriteria
1100 If Me.chkYesNo = True Then
1120 DoCmd.OpenReport "<your report name>", acViewPreview
1140 Else
1160 DoCmd.OpenReport "<your report name>", acViewPreview
1180 End If
1200 ElseIf Me.cboChooseReport.value = "<your report name>" Then
1220 If IsNull(Me.txtFromDate) Or Not IsDate(Me.txtFromDate) Then
1240 MsgBox "You must enter a valid From Date", vbOKOnly, "Invalid Date"
1260 Exit Sub
1280 End If
1300 If IsNull(Me.txtToDate) Or Not IsDate(Me.txtToDate) Then
1320 MsgBox "You must enter a valid To Date", vbOKOnly, "Invalid Date"
1340 Exit Sub
1360 End If
1380 Me.txtStartDate = Me.txtFromDate
1400 Me.txtEndDate = Me.txtToDate
1420 DoCmd.OpenReport Me.cboChooseReport.value, acViewPreview
. . .
4200 Else
4220 BuildReportCriteria
4240 If Me.cboChooseReport.value = "<your report name>" Then
4280 On Error Resume Next
4300 DoCmd.DeleteObject acTable, "<my temp table>"
4320 On Error GoTo Error_Trap
4340 Set qryBase = New ADODB.Command
4360 qryBase.ActiveConnection = gv_DBS_Local
4380 qryBase.CommandText = ("<my make table query>")
4400 qryBase.CommandType = adCmdStoredProc
4420 qryBase.Execute
4440 ElseIf Me.cboChooseReport.value = "<your report name>" Then
4460 On Error Resume Next
4480 DoCmd.DeleteObject acTable, "My_temp"
4500 On Error GoTo Error_Trap
4520 Set qryBase = New ADODB.Command
4540 qryBase.ActiveConnection = gv_DBS_Local
4560 qryBase.CommandText = ("<my make table query>")
4580 qryBase.CommandType = adCmdStoredProc
4600 qryBase.Execute
4720 End If
4730 DoCmd.Hourglass False
4740 DoCmd.OpenReport Me.cboChooseReport.value, acViewPreview
4760 End If
4780 Else
4800 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."
4860 strOpen_Report = Open_Report
4880 DoCmd.SelectObject acReport, strOpen_Report
4900 DoCmd.ShowToolbar "tbForPost"
4920 End If
4940 Else
4960 MsgBox "Please Choose Report", vbExclamation, "Choose Report"
4980 End If
5000 Exit Sub
5020 Error_Trap:
5030 Err.Source = "Form_frmReportChooser: cmdShowQuery_Click - Report: " & Nz(Me.cboChooseReport.value) & " at Line: " & Erl
5040 If Err.Number = 2501 Then ' MsgBox "You chose not to open this report.", vbOKOnly, "Report cancelled"
5060 Exit Sub
5080 ElseIf Err.Number = 0 Or Err.Number = 7874 Then
5100 Resume Next
5110 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.
5120 i = 1
Set Errs1 = gv_DBS_SQLServer.Errors
5130 Err.Description = Err.Description & "; Err.Count = " & gv_DBS_SQLServer.Errors.Count & "; "
5140 For Each errLoop In Errs1
5150 With errLoop
5160 Err.Description = Err.Description & "Error #" & i & ":" & " ADO Error#" & .Number & _
" Description= " & .Description
5170 i = i + 1
5180 End With
5190 Next
5240 End If
5250 DocAndShowError
5260 Exit Sub
5270 Resume Next
5280 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
1000 On Error GoTo Error_Trap
1020 strSQL = "select * from ctrlReportOptions " & _
"where ID = " & Me.cboChooseReport.Column(3) & _
" order by OptionOrder;"
1080 Set rs = New ADODB.Recordset
1100 rs.Open strSQL, CurrentProject.Connection, adOpenDynamic
1120 If rs.EOF Then
1140 strCriteria = " Report Criteria: None"
1160 Else
1180 strCriteria = " Report Criteria: "
1200 End If
1220 Do While Not rs.EOF
1240 Set ctlEach = Me.Controls(rs!ControlName)
1260 If ctlEach.ControlType = acTextBox Or ctlEach.ControlType = acComboBox Then
1280 If ctlEach.value <> "*" And ctlEach.Name <> "cboChooseReport" And ctlEach.Name <> "cboWhatever" Then
1300 strCriteria = strCriteria & ctlEach.Tag & " = " & ctlEach.value & " , "
1320 End If
1340 End If
1360 rs.MoveNext
1380 Loop
1400 rs.Close
1420 Set rs = Nothing
1440 If Me.chkYesNo = -1 Then
1460 strCriteria = strCriteria & "Non-zero balances only = Yes"
1480 Else
'return string with all choosen criteria and remove last " , " from the end of string
1500 strCriteria = Left$(strCriteria, Len(strCriteria) - 3)
1520 End If
1540 fvstr_ReportCriteria = strCriteria
1580 Set ctlEach = Nothing
1600 Exit Function
1620 Error_Trap:
1640 If Err.Number = 2447 Then
1660 Resume Next
1680 End If
1700 Err.Source = "Form_frmReportChooser: BuildReportCriteria at Line: " & Erl
1720 DocAndShowError
1740 Exit Function
1760 Resume Next
End Function