ACCESS VBA编程（六）ACCESS查询（上）

竹笛

分段统计人数
这样一个表  tblScore：
班级  姓名  总分  语文  数学
1班   a     601   108   120
2班   b     589   112   133
3班   C     551   98    145
2班   D     502   80    124
1班   E     508   90    8         3班   F     561   97    135 TRANSFORM Count(tblScore.总分) AS 总分OfCount
Select tblScore.班级
FROM tblScore
GROUP BY tblScore.班级
PIVOT Switch([总分]>=600,">=600",[总分]>=550 And [总分]<600,"550-599",[总分]>=500 And [总分]<550,"500-549",True,"Other") In (">=600","550-599","500-549","Other");
可得到第一個查詢
班级 总分600分以上人数  总分550-600人数  总分550以下人数
1班  1                     0              1               
2班  0                     1              1               
        3班  0                     2              0      

  用代码在ACCESS中生成永久查询
来源：竹笛整理的技巧集
dim strSQL as string
dim qdf as QueryDef
strSQL = "Select * from tblaa" 'tblaa为表
Set qdf = CurrentDb.CreateQueryDef("创建的查询", strSQL)
DoCmd.OpenQuery qdf.Name
用代码删除一个已存在的查询
来源：爱赛思应用俱乐部 wxjgw
Dim Query1 As QueryDef
CurrentDb.QueryDefs.Refresh　　　　　　　
For Each Query1 In CurrentDb.QueryDefs　　
　　If Query1.Name = "想要删除的查询名称" Then
　　　　CurrentDb.QueryDefs.Delete Query1.Name
　　　　Exit For
End If  
        Next Query1  

使用ADO和SQL语句建立一个新查询
来源：ACCESS中国 huanghai
Dim cat  As New ADOX.Catalog
Dim cmd As New ADODB.Command
Set cat.ActiveConnection = CurrentProject.Connection
cmd.CommandText = "Select * FROM 表1"
        cat.Views.Append "newView", cmd
以窗体的文体框为条件进行模糊查询时查询的设计视图中准则：
Like IIf(IsNull([Forms]![存书查询窗体]![作者]),'*','*' & [Forms]![存书查询窗体]![作者] & '*')

用VBA代码生成一个条件组合的字符串作为子窗体的窗体筛选的条件来实现窗体的多条件查询。         Option Compare Database
        '由浅入深的介绍几种最常用的利用主/子窗体来实现查询的方法，
'使初学者和有一定VBA基础的人可以更好的使用窗体查询这种手段。
'
'本例程是讲解用VBA代码生成一个条件组合的字符串作为子窗体的
'窗体筛选的条件来实现窗体的多条件查询。
'
Private Sub cmd查询_Click()
On Error GoTo Err_cmd查询_Click
     Dim strWhere As String  '定义条件字符串
    strWhere = "" '设定初始值－空字符串

    '判断【书名】条件是否有输入的值   
         If Not IsNull(Me.书名) Then
                '有输入
        strWhere = strWhere & "([书名] like '*" & Me.书名 & "*') AND "
     End If
     
     '判断【类别】条件是否有输入的值
    If Not IsNull(Me.类别) Then
         '有输入
        strWhere = strWhere & "([类别] like '" & Me.类别 & "') AND "
     End If
   
         '判断【作者】条件是否有输入的值
     If Not IsNull(Me.作者) Then        '有输入
        strWhere = strWhere & "([作者] like '*" & Me.作者 & "*') AND "
     End If

'判断【出版社】条件是否有输入的值  
    If Not IsNull(Me.出版社) Then
                '有输入
        strWhere = strWhere & "([出版社] like '" & Me.出版社 & "') AND "
     End If

      '判断【单价】条件是否有输入的值，由于有【单价开始】【单价截止】两个文本框
    '所以要分开来考虑
    If Not IsNull(Me.单价开始) Then
         '【单价开始】有输入
        strWhere = strWhere & "([单价] >= " & Me.单价开始 & ") AND "
     End If
     If Not IsNull(Me.单价截止) Then
         '【单价截止】有输入
        strWhere = strWhere & "([单价] <= " & Me.单价截止 & ") AND "
     End If
     
     
    '判断【进书日期】条件是否有输入的值，由于有【进书日期开始】【进书日期截止】两个文本框
    '所以要分开来考虑
    If Not IsNull(Me.进书日期开始) Then
         '【进书日期开始】有输入
        strWhere = strWhere & "([进书日期] >= #" & Format(Me.进书日期开始, "yyyy-mm-dd") & "#) AND "
     End If
     If Not IsNull(Me.进书日期截止) Then
         '【进书日期截止】有输入
        strWhere = strWhere & "([进书日期] <= #" & Format(Me.进书日期截止, "yyyy-mm-dd") & "#) AND "
     End If
     
     '如果输入了条件，那么strWhere的最后肯定有" AND "，这是我们不需要的，
    '要用LEFT函数截掉这5个字符。
    If Len(strWhere) > 0 Then
         '有输入条件
        strWhere = Left(strWhere, Len(strWhere) - 5)
     End If
     
     '先在立即窗口显示一下strWhere的值，代码调试完成后可以取消下一句
    Debug.Print strWhere
     
     
     '让子窗体应用窗体查询
    Me.存书查询子窗体.Form.Filter = strWhere
     Me.存书查询子窗体.Form.FilterOn = True
     
     '在子窗体筛选后要运行一下自编子程序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
'这里将使用DAO来改变查询的SQL语句，必须先在“工具”→“引用”中选择
'Microsoft DAO 3.6 Object Library.
    Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象
    Dim strWhere, strSQL As String
     
     strWhere = Me.存书查询子窗体.Form.Filter
     If strWhere = "" Then
         '没有条件
        strSQL = "Select * FROM [存书查询]"
     Else
         '有条件
        strSQL = "Select * FROM [存书查询] Where " & strWhere
     End If
     
     Set qdf = CurrentDb.QueryDefs("查询结果")
     qdf.SQL = strSQL
     qdf.Close
     
     Set qdf = Nothing
     
     DoCmd.OutputTo acOutputQuery, "查询结果", acFormatXLS, , True

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
     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()
'这是一个自编子程序，专门用来检查子窗体上的记录数，
'以便修改主窗体上的“计数”和“合计”的控件来源，
'以防止出现“#错误”。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    If Me.存书查询子窗体.Form.Recordset.RecordCount > 0 Then
         '子窗体的记录数>0
         Me.计数.ControlSource = "=[存书查询子窗体].[Form].[txt计数]"
         Me.合计.ControlSource = "=[存书查询子窗体].[Form].[txt单价合计]"
     Else
         '子窗体的记录数=0
         Me.计数.ControlSource = "=0"
         Me.合计.ControlSource = "=0"
     End If  
        End Sub

lvenqi

很好，解决了一个问题，谢谢！！！