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

竹笛

用VBA代码+DAO生成带条件的交叉表查询
Option Compare Database
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'由浅入深的介绍几种最常用的利用主/子窗体来实现查询的方法，
'使初学者和有一定VBA基础的人可以更好的使用窗体查询这种手段。
'
'本例程是讲解用VBA代码+DAO生成带条件的交叉表查询。

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 '" & 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
     
     '根据是否有条件来设定交叉表查询的SQL语句
    If Len(strWhere) > 0 Then
         strSQL = "TRANSFORM Sum(存书查询.单价) AS 单价之Sum Select 存书查询.类别 FROM 存书查询 "
         strSQL = strSQL & "Where(" & strWhere
         strSQL = strSQL & ") GROUP BY 存书查询.类别 PIVOT Format([进书日期],'yyyy/mm')"
     Else
         strSQL = "TRANSFORM Sum(存书查询.单价) AS 单价之Sum" & _
                  " Select 存书查询.类别" & _
                  " FROM 存书查询" & _
                  " GROUP BY 存书查询.类别" & _
                  " PIVOT Format([进书日期],'yyyy/mm')"
     End If
     
     '修改交叉表查询的SQL语句
    Set qdf = CurrentDb.QueryDefs("存书查询_交叉表")
     qdf.SQL = strSQL
     qdf.Close
     
     Set qdf = Nothing
     
     '显示交叉表的内容，不能直接刷新
    Me.存书查询子窗体.SourceObject = ""
     Me.存书查询子窗体.SourceObject = "查询.存书查询_交叉表"
     
     '刷新计数和合计显示
    Me.计数 = DCount("*", "存书查询_交叉表")
     Me.合计 = DSum("[单价]", "存书查询", strWhere)
     
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语句，
'所以这里我们直接导出就可以了。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    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
'这里将使用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
                 
             Case acComboBox '是组合框，也要清空
                ctl.Value = Null
             '其它类型的控件不处理
        
         End Select
     Next
     
     strSQL = "TRANSFORM Sum(存书查询.单价) AS 单价之Sum" & _
              " Select 存书查询.类别" & _
              " FROM 存书查询" & _
              " GROUP BY 存书查询.类别" & _
              " PIVOT Format([进书日期],'yyyy/mm')"
     
     '修改交叉表查询的SQL语句
    Set qdf = CurrentDb.QueryDefs("存书查询_交叉表")
     qdf.SQL = strSQL
     qdf.Close
     
     Set qdf = Nothing
     
     '显示交叉表的内容，不能直接刷新
    Me.存书查询子窗体.SourceObject = ""
     Me.存书查询子窗体.SourceObject = "查询.存书查询_交叉表"
     
     '刷新计数和合计显示
    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
     Dim stDocName, strWhere As String
     stDocName = "藏书情况报表"   
     DoCmd.OpenReport stDocName, acViewPreview
     
     
Exit_cmd预览报表_Click:
     Exit Sub


Err_cmd预览报表_Click:
     MsgBox Err.Description
     Resume Exit_cmd预览报表_Click
     
        End Sub

Private Sub Form_Open(Cancel As Integer)
'如果没有这一段代码，窗体打开时，虽然子窗体有显示，但下面的两个文本框是空的。
    '刷新计数和合计显示
    Me.计数 = DCount("*", "存书查询_交叉表")
     Me.合计 = DSum("[单价]", "存书查询")
End Sub

*在报表的打开事件中写：
Private Sub Report_Open(Cancel As Integer)
'根据交叉表查询的实际字段数来设定报表各节可以显示的控件数。
'需要使用DAO 3.6
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
  Dim rst As DAO.Recordset, intFieldsNum As Integer, I As Integer
     
     '打开查询
    Set rst = CurrentDb.OpenRecordset("Select * FROM [存书查询_交叉表] Where 1=2")
     
     rst.MoveLast
     rst.MoveFirst
     
     Debug.Print rst.RecordCount
     
     '记录字段总数
    intFieldsNum = rst.Fields.Count
     
     '由于报表仅有10个可变字段＋1个固定字段，所以，如果字段总数>11时，
    '只显示前面的11个字段，并给出提示。
    If intFieldsNum > 11 Then
         intFieldsNum = 11
         MsgBox "字段总数太多，报表仅显示前11个字段。", vbInformation + vbOKOnly, "提示"
     End If
     
     For I = 1 To 10
         
         If I <= (intFieldsNum - 1) Then
         '有对应字段，rst.Fields(I) 中 rst.Fields(0)是第一个，是“类别”字段。
        
             '页眉标签可见
            Section(acPageHeader).Controls("标签" & I).Caption = rst.Fields(I).Name
             Section(acPageHeader).Controls("标签" & I).Visible = True
            
             '主体字段可见
            Section(acDetail).Controls("txt" & I).ControlSource = rst.Fields(I).Name
             Section(acDetail).Controls("txt" & I).Visible = True
            
             '报表页脚合计可见
            Section(acFooter).Controls("txt合计" & I).ControlSource = "=SUM(NZ([" & rst.Fields(I).Name & "],0))"
             Section(acFooter).Controls("txt合计" & I).Visible = True
         
         Else
         '没有对应字段
        
             '页眉标签不可见
            Section(acPageHeader).Controls("标签" & I).Visible = False
            
             '主体字段不可见
            Section(acDetail).Controls("txt" & I).ControlSource = ""
             Section(acDetail).Controls("txt" & I).Visible = False
            
             '报表页脚合计可见
            Section(acFooter).Controls("txt合计" & I).ControlSource = ""
             Section(acFooter).Controls("txt合计" & I).Visible = False
            
         End If
     Next
     
     rst.Close
     Set rst = Nothing
     
End Sub


进行多条件查询,  希望某一条件为空时显示全部
where  name1 like *temp1* and name2 like *temp2*


如何判断奇数（单数）、偶数（双数）？
dim a as string
(这里有一段给a赋值的代码）
if a mod 2=0 then
   msgbox"这是一个偶数"
esle
msgbox"这是一个奇数"
end if
计算在每个范围内的数量
本示例假设您有一个“Orders”表，且里头含有一个“Freight”字段。程序建立一个“选择”来计算运费落在某些范围内的订单数量。Partition 函数是用来确定这些范围，然后调用 SQL Count 函数来计算在每个范围内的订单数量。本示例中，Partition 函数的参数值为 start = 0，stop = 500，interval = 50。第一个范围会是 0：49，每隔 50 一个范围，依次而下直到运费为 500 为止。
Select DISTINCTROW Partition([freight],0, 500, 50) AS Range,
Count(Orders.Freight) AS Count
FROM orders
GROUP BY Partition([freight],0,500,50);
使用 Trim 函数显示字段的值，并且删除首尾的空格。
使用 Trim 函数显示“地址”字段的值，并且删除首尾的空格。
=Trim([地址])
Like函数示例：
查询条件为“Like "*" & [forms]![销售单输入]![文本26]”，当我输入60时，所有包含60的记录全部得出，诸如160、260、360等


只想要60的记录，并且当不输入任何数据时，所有记录全部得出
Like IIf([forms]![销售单输入]![文本26] Is Not Null,[forms]![销售单输入]![文本26],"*")
使用 Left 函数来得到某字符串最左边的几个字符。
Dim AnyString, MyStr
AnyString = "Hello World"    ' 定义字符串。
MyStr = Left(AnyString, 1)    ' 返回 "H"。
MyStr = Left(AnyString, 7)    ' 返回 "Hello W"。
MyStr = Left(AnyString, 20)    ' 返回 "Hello World"。


使用 Mid 语句来得到某个字符串中的几个字符。
Dim MyString, FirstWord, LastWord, MidWords
MyString = "Mid Function Demo"    建立一个字符串。
FirstWord = Mid(MyString, 1, 3)    ' 返回 "Mid"。
LastWord = Mid(MyString, 14, 4)    ' 返回 "Demo"。
MidWords = Mid(MyString, 5)    ' 返回 "Funcion Demo"。


使用 Right 函数来返回某字符串右边算起的几个字符。
Dim AnyString, MyStr
AnyString = "Hello World"    ' 定义字符串。
MyStr = Right(AnyString, 1)    ' 返回 "d"。
MyStr = Right(AnyString, 6)    ' 返回 " World"。
MyStr = Right(AnyString, 20)    ' 返回 "Hello World"。
使用 InStr 函数来查找某字符串在另一个字符串中首次出现的位置。
Dim SearchString, SearchChar, MyPos
SearchString ="XXpXXpXXPXXP"    ' 被搜索的字符串。
SearchChar = "P"    ' 要查找字符串 "P"。


' 从第四个字符开始，以文本比较的方式找起。返回值为 6（小写 p）。
' 小写 p 和大写 P 在文本比较下是一样的。
MyPos = Instr(4, SearchString, SearchChar, 1)   


' 从第一个字符开使，以二进制比较的方式找起。返回值为 9（大写 P）。
' 小写 p 和大写 P 在二进制比较下是不一样的。
MyPos = Instr(1, SearchString, SearchChar, 0)


' 缺省的比对方式为二进制比较（最后一个参数可省略）。
MyPos = Instr(SearchString, SearchChar)    ' 返回 9。


MyPos = Instr(1, SearchString, "W")    ' 返回 0。


使用 Space 函数来生成一个字符串，字符串的内容为空格，长度为指定的长度。
Dim MyString
' 返回 10 个空格的字符串。
MyString = Space(10)


' 将 10 个空格插入两个字符串中间。
MyString = "Hello" & Space(10) & "World"


使用 String 函数来生成一指定长度，且只含单一字符的字符串。
Dim MyString
MyString = String(5, "*")    ' 返回 "*****"。
MyString = String(5, 42)    ' 返回 "*****"。
MyString = String(10, "ABC")    ' 返回 "AAAAAAAAAA"。
使用 DLookup 函数
=DLookup("[联系人姓名]", "[供应商]", "[供应商ID] ="[供应商ID])


一、变量为数字
If IsNull(DLookup("[纺号]", "另一个表的名字", "[纺号] = " & 文本框的值)) Then
     Msgbox "该纺号不存在!"
End If
二、变量为字符串
If IsNull(DLookup("[纺号]", "另一个表的名字", "[纺号] = '" & 文本框的值 &"'")) Then
     Msgbox "该纺号不存在!"
End If

使用 Len 函数来得知某字符串的长度（字符数）或某变量的大小（位数）。
Type...End Type 程序区块定义一个自定义数据类型 CustomerRecord。如果该数据类型定义在对象类模块中，则必需以关键字 Private 开头（表示为私有）。若定义在常规模块中，Type 定义就可以为 Public。
Type CustomerRecord    ' 定义用户自定义的数据类型。
    ID As Integer    ' 将此定义放在常规模块中。
    Name As String * 10
     Address As String * 30
End Type
Dim Customer As CustomerRecord    ' 声明变量。
Dim MyInt As Integer, MyCur As Currency
Dim MyString, MyLen
MyString = "Hello World"    ' 设置变量初值。
MyLen = Len(MyInt)    ' 返回 2。
MyLen = Len(Customer)    ' 返回 42。
MyLen = Len(MyString)    ' 返回 11。
MyLen = Len(MyCur)    ' 返回 8。

Round四舍五入。
Round(数值表达式，小数点右边应保留的位数)

用按钮在窗体中按指定字段查找记录
例一：
Private Sub 查找记录_Click()
On Error GoTo Err_查找记录_Click
''指定字段名称[学生编号]
     DoCmd.GoToControl "学生编号"
     DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_查找记录_Click:
    Exit Sub

Err_查找记录_Click:
    MsgBox Err.Description
     Resume Exit_查找记录_Click
            End Sub
例二
Private Sub 按毕业时间查找_Click()
On Error GoTo 按毕业时间查找_Click_Err
''在窗体中按基础表的参数筛选
    DoCmd.ApplyFilter "", "Left([学生基本情况]![学生编号],4)+6=[请输入学生毕业年份(四位数)]"

按毕业时间查找_Click_Exit:
     Exit Sub

按毕业时间查找_Click_Err:
     MsgBox Error$
     Resume 按毕业时间查找_Click_Exit
End Sub

悠哉游哉

谢谢！！！

Bettyexcel

谢谢楼主的分享！