ACCESS-VBA编程
Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象 Dim strWhere, strSQL As String
strWhere = Me.存书查询子窗体.Form.Filter If strWhere = \ '没有条件
strSQL = \存书查询]\ Else
'有条件
strSQL = \存书查询] WHERE \ End If
Set qdf = CurrentDb.QueryDefs(\查询结果\ qdf.SQL = strSQL qdf.Close
Set qdf = Nothing
DoCmd.OutputTo acOutputQuery, \查询结果\
Exit_cmd导出_Click: Exit Sub
Err_cmd导出_Click:
MsgBox Err.Description Resume Exit_cmd导出_Click End Sub
Private Sub cmd清除_Click() On Error GoTo Err_cmd清除_Click '刘小军(Alex) 2003-5-22
'这里将使用FOR EACH CONTROL的方法来清除控件的值 '这在控件比较多的时候非常有用。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim ctl As Control
For Each ctl In Me.Controls
'根据ctl的控件类型来选择 Select Case ctl.ControlType
Case acTextBox '是文本框，要清空(注意，子窗体下面还有两个锁定的文本框不能赋值) If ctl.Locked = False Then ctl.Value = Null
Case acComboBox '是组合框，也要清空 ctl.Value = Null '其它类型的控件不处理
End Select
46
ACCESS-VBA编程
Next
'取消子窗体的筛选
Me.存书查询子窗体.Form.Filter = \
Me.存书查询子窗体.Form.FilterOn = False
'在子窗体取消筛选后要运行一下自编子程序CheckSubformCount() Call CheckSubformCount
Exit_cmd清除_Click: Exit Sub
Err_cmd清除_Click:
MsgBox Err.Description Resume Exit_cmd清除_Click End Sub
Private Sub cmd预览报表_Click() On Error GoTo Err_cmd预览报表_Click
Dim stDocName, strWhere As String
stDocName = \藏书情况报表\
strWhere = Me.存书查询子窗体.Form.Filter
'在打开报表的同时把子窗体的筛选条件字符串也传递给报表， '这样地话报表也会显示和子窗体相同的记录。
DoCmd.OpenReport stDocName, acPreview, , strWhere
Exit_cmd预览报表_Click: Exit Sub
Err_cmd预览报表_Click: MsgBox Err.Description
Resume Exit_cmd预览报表_Click End Sub
Private Sub CheckSubformCount() '刘小军(Alex) 2003-5-22
'这是一个自编子程序，专门用来检查子窗体上的记录数， '以便修改主窗体上的“计数”和“合计”的控件来源， '以防止出现“#错误”。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
If Me.存书查询子窗体.Form.Recordset.RecordCount > 0 Then '子窗体的记录数>0
Me.计数.ControlSource = \存书查询子窗体].[Form].[txt计数]\
Me.合计.ControlSource = \存书查询子窗体].[Form].[txt单价合计]\
47
ACCESS-VBA编程
Else
'子窗体的记录数=0
Me.计数.ControlSource = \ Me.合计.ControlSource = \ End If End Sub
用VBA代码+DAO生成带条件的交叉表查询 Option Compare Database
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ '刘小军（ALEX），2003-5-26 '
'由浅入深的介绍几种最常用的利用主/子窗体来实现查询的方法， '使初学者和有一定VBA基础的人可以更好的使用窗体查询这种手段。 '
'本例程是讲解用VBA代码+DAO生成带条件的交叉表查询。 '
'欢迎访问 ACCESS编程应用网 www.accxp.com
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub cmd查询_Click() On Error GoTo Err_cmd查询_Click
Dim strWhere As String '定义条件字符串
Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象 Dim strSQL As String
strWhere = \设定初始值－空字符串
'判断【类别】条件是否有输入的值 If Not IsNull(Me.类别) Then '有输入
strWhere = strWhere & \类别] like '\类别 & \ End If
'判断【出版社】条件是否有输入的值 If Not IsNull(Me.出版社) Then '有输入
strWhere = strWhere & \出版社] like '\出版社 & \ End If
'判断【单价】条件是否有输入的值，由于有【单价开始】【单价截止】两个文本框 '所以要分开来考虑
If Not IsNull(Me.单价开始) Then '【单价开始】有输入
strWhere = strWhere & \单价] >= \单价开始 & \ End If
If Not IsNull(Me.单价截止) Then '【单价截止】有输入
48
ACCESS-VBA编程
strWhere = strWhere & \单价] <= \单价截止 & \ End If
'判断【进书日期】条件是否有输入的值，由于有【进书日期开始】【进书日期截止】两个文本框 '所以要分开来考虑
If Not IsNull(Me.进书日期开始) Then '【进书日期开始】有输入
strWhere = strWhere & \进书日期] >= #\进书日期开始, \\
End If
If Not IsNull(Me.进书日期截止) Then '【进书日期截止】有输入
strWhere = strWhere & \进书日期] <= #\进书日期截止, \\
End If
'如果输入了条件，那么strWhere的最后肯定有\，这是我们不需要的， '要用LEFT函数截掉这5个字符。 If Len(strWhere) > 0 Then '有输入条件
strWhere = Left(strWhere, Len(strWhere) - 5) End If
'先在立即窗口显示一下strWhere的值，代码调试完成后可以取消下一句 'Debug.Print strWhere
'根据是否有条件来设定交叉表查询的SQL语句 If Len(strWhere) > 0 Then
strSQL = \存书查询.单价) AS 单价之Sum SELECT 存书查询.类别 FROM 存书查询 \ strSQL = strSQL & \
strSQL = strSQL & \存书查询.类别 PIVOT Format([进书日期],'yyyy/mm')\ Else
strSQL = \存书查询.单价) AS 单价之Sum\ \存书查询.类别\ \存书查询\
\存书查询.类别\
\进书日期],'yyyy/mm')\ End If
'修改交叉表查询的SQL语句
Set qdf = CurrentDb.QueryDefs(\存书查询_交叉表\ qdf.SQL = strSQL qdf.Close
Set qdf = Nothing
'显示交叉表的内容，不能直接刷新 Me.存书查询子窗体.SourceObject = \
Me.存书查询子窗体.SourceObject = \查询.存书查询_交叉表\
49
ACCESS-VBA编程
'刷新计数和合计显示
Me.计数 = DCount(\存书查询_交叉表\
Me.合计 = DSum(\单价]\存书查询\
Exit_cmd查询_Click: Exit Sub
Err_cmd查询_Click:
MsgBox Err.Description Resume Exit_cmd查询_Click End Sub
Private Sub cmd导出_Click() On Error GoTo Err_cmd导出_Click '刘小军(Alex) 2003-5-27
'由于前面我们已经通过DAO修改了“存书查询_交叉表”的SQL语句， '所以这里我们直接导出就可以了。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
DoCmd.OutputTo acOutputQuery, \存书查询_交叉表\
Exit_cmd导出_Click: Exit Sub
Err_cmd导出_Click:
MsgBox Err.Description Resume Exit_cmd导出_Click End Sub
Private Sub cmd清除_Click() On Error GoTo Err_cmd清除_Click '刘小军(Alex) 2003-5-27
'这里将使用FOR EACH CONTROL的方法来清除控件的值 '这在控件比较多的时候非常有用。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim ctl As Control
Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象 Dim strSQL As String
For Each ctl In Me.Controls
'根据ctl的控件类型来选择 Select Case ctl.ControlType
Case acTextBox '是文本框，要清空(注意，子窗体下面还有两个锁定的文本框不能赋值) If ctl.Locked = False Then ctl.Value = Null
50