组合查询
这部分也是机房收费系统中的重难点，它的难点在于查询语句和它的逻辑思路：
我们以上机记录查询窗体为例来看一下：首先我们会发现这个窗体的字段名中不光有卡号、姓名，而且还有上机日期，上机时间，下机日期和下机时间，所以这个时候我们就需要用一个时间控件来减轻用户的负担！
为了便于和数据库的连接，我们需要定义以下两个函数：
Public Function field(strfield As String) As String
Select Case strfield
Case "卡号"
field = "cardno"
Case "姓名"
field = "studentName"
Case "上机日期"
field = "ondate"
Case "上机时间"
field = "ontime"
Case "下机日期"
field = "offdate"
Case "下机时间"
field = "offtime"
Case "消费金额"
field = "consume"
Case "金额"
field = "cash"
Case "备注"
field = "status"
End Select
End Function
Public Function RelationName(strRelationName As String) As String
Select Case strRelationName
Case "与"
RelationName = "and"
Case "或"
RelationName = "or"
End Select
End Function
根据不同字段名显示不同的控件
'第一组判断
Private Sub cboField1_click()
If Trim(cboField1.Text) = "卡号" Or Trim(cboField1.Text) = "姓名" Or Trim(cboField1.Text) = "余额" Or Trim(cboField1.Text) = "消费金额" Then
txtContent1.Visible = True
DTPicker1.Visible = False
Else
'日期型
If Trim(cboField1.Text) = "上机日期" Or Trim(cboField1.Text) = "下机日期" Then
txtContent1.Visible = False
DTPicker1.Visible = True
DTPicker1.Format = dptcustom
Else
'时间
txtContent1.Visible = False
DTPicker1.Visible = True
DTPicker1.Format = dtpTime
End If
End If
End Sub
'第二组判断
Private Sub cboField2_click()
If Trim(cboField2.Text) = "卡号" Or Trim(cboField2.Text) = "姓名" Or Trim(cboField2.Text) = "余额" Or Trim(cboField2.Text) = "消费金额" Then
txtContent2.Visible = True
DTPicker2.Visible = False
Else
'日期型
If Trim(cboField2.Text) = "上机日期" Or Trim(cboField2.Text) = "下机日期" Then
txtContent2.Visible = False
DTPicker2.Visible = True
DTPicker2.Format = dptcustom
Else
'时间
txtContent2.Visible = False
DTPicker2.Visible = True
DTPicker2.Format = dtpTime
End If
End If
End Sub
'第三组判断
Private Sub cboField3_click()
If Trim(cboField3.Text) = "卡号" Or Trim(cboField3.Text) = "姓名" Or Trim(cboField3.Text) = "余额" Or Trim(cboField3.Text) = "消费金额" Then
txtContent3.Visible = True
DTPicker3.Visible = False
Else
'日期型
If Trim(cboField3.Text) = "上机日期" Or Trim(cboField3.Text) = "下机日期" Then
txtContent3.Visible = False
DTPicker3.Visible = True
DTPicker3.Format = dptcustom
Else
'时间
txtContent3.Visible = False
DTPicker3.Visible = True
DTPicker3.Format = dtpTime
End If
End If
根据字段名的不同出现不同的符号：
Private Sub cboOpSign1_dropdown()
'清空内容
cboOpsign1.Clear
If Trim(cboField1.Text) = "卡号" Or Trim(cboField1.Text) = "姓名" Or Trim(cboField1.Text) = "金额" Or Trim(cboField1.Text) = "消费金额" Then
cboOpsign1.AddItem "="
cboOpsign1.AddItem "<>"
Else
cboOpsign1.AddItem "="
cboOpsign1.AddItem "<>"
cboOpsign1.AddItem "<"
cboOpsign1.AddItem ">"
End If
End Sub
Private Sub cboOpSign2_dropdown()
'清空内容
cboOpsign2.Clear
If Trim(cboField2.Text) = "卡号" Or Trim(cboField2.Text) = "姓名" Or Trim(cboField2.Text) = "金额" Or Trim(cboField2.Text) = "消费金额" Then
cboOpsign2.AddItem "="
cboOpsign2.AddItem "<>"
Else
cboOpsign2.AddItem "="
cboOpsign2.AddItem "<>"
cboOpsign2.AddItem "<"
cboOpsign2.AddItem ">"
End If
End Sub
Private Sub cboOpSign3_dropdown()
'清空内容
cboOpsign3.Clear
If Trim(cboField3.Text) = "卡号" Or Trim(cboField3.Text) = "姓名" Or Trim(cboField3.Text) = "金额" Or Trim(cboField3.Text) = "消费金额" Then
cboOpsign3.AddItem "="
cboOpsign3.AddItem "<>"
Else
cboOpsign3.AddItem "="
cboOpsign3.AddItem "<>"
cboOpsign3.AddItem "<"
cboOpsign3.AddItem ">"
End If
End Sub
核心部分：组合查询
Private Sub cmdCheck_Click()
Dim txtsql As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
'添加表头
With MSHFlexGrid1
.Rows = 1
.CellAlignment = 4
.ColAlignment = 4
.TextMatrix(0, 0) = "卡号"
.TextMatrix(0, 1) = "姓名"
.TextMatrix(0, 2) = "上机日期"
.TextMatrix(0, 3) = "上机时间"
.TextMatrix(0, 4) = "下机日期"
.TextMatrix(0, 5) = "下机时间"
.TextMatrix(0, 6) = "消费金额"
.TextMatrix(0, 7) = "金额"
.TextMatrix(0, 8) = "备注"
End With
txtsql = "select * from line_info where "
Select Case Trim(cboField1.Text)
'判断是否为日期型
Case "上机日期"
DTPicker1.MaxDate = Date
If Format(DTPicker1.Value, "yyyy-mm-dd") > Format(DTPicker1.MaxDate, "yyyy-mm-dd") Then
MsgBox "您选择的日期不能大于当前日期", 0 + 48, "提示"
Exit Sub
End If
txtContent1.Text = Format(DTPicker1.Value, "yyyy-mm-dd")
Case "下机日期"
DTPicker1.MaxDate = Date
If Format(DTPicker1.Value, "yyyy-mm-dd") > Format(DTPicker1.MaxDate, "yyyy-mm-dd") Then
MsgBox "您选择的日期不能大于当前日期", 0 + 48, "提示"
Exit Sub
End If
txtContent1.Text = Format(DTPicker1.Value, "yyyy-mm-dd")
'判断是否为时间类型
Case "上机时间"
txtContent1.Text = Format(DTPicker1.Value, "hh:mm:ss")
Case "下机时间"
txtContent1.Text = Format(DTPicker1.Value, "hh:mm:ss")
'为其他
If Trim(txtContent1.Text) = "" Then
txtContent1.SetFocus
End If
End Select
'第一组判断
'如果第一个字段名为空或者第一个操作符为空或内容为空，则显示msgbox中的内容，否则，退出程序
If Trim(cboField1.Text) = "" Or Trim(cboOpsign1.Text) = "" Or Trim(txtContent1.Text) = "" Then
MsgBox "请将第一行内容填写完整", 0, "温馨提示"
Exit Sub
Else
'将查询到的部分赋予到cbo框中
txtsql = txtsql & " " & field(cboField1.Text) & " " & Trim(cboOpsign1.Text) & "'" & Trim(txtContent1.Text) & "'"
'第二组判断
If cboRelation1.Text <> "" Then
Select Case Trim(cboField2.Text)
'判断是否为日期型
Case "上机日期"
DTPicker2.MaxDate = Date
If Format(DTPicker2.Value, "yyyy-mm-dd") > Format(DTPicker2.MaxDate, "yyyy-mm-dd") Then
MsgBox "您选择的日期不能大于当前日期", 0 + 48, "提示"
Exit Sub
End If
txtContent2.Text = Format(DTPicker2.Value, "yyyy-mm-dd")
Case "下机日期"
DTPicker2.MaxDate = Date
If Format(DTPicker2.Value, "yyyy-mm-dd") > Format(DTPicker2.MaxDate, "yyyy-mm-dd") Then
MsgBox "您选择的日期不能大于当前日期", 0 + 48, "提示"
Exit Sub
End If
txtContent2.Text = Format(DTPicker2.Value, "yyyy-mm-dd")
'判断是否为时间类型
Case "上机时间"
txtContent2.Text = Format(DTPicker2.Value, "hh:mm:ss")
Case "下机时间"
txtContent2.Text = Format(DTPicker2.Value, "hh:mm:ss")
'为其他
If Trim(txtContent2.Text) = "" Then
txtContent2.SetFocus
End If
End Select
If Trim(cboField2.Text) = "" Or Trim(cboOpsign2.Text) = "" Or Trim(txtContent2.Text) = "" Then
MsgBox "请将第二行内容填写完整", 0, "温馨提示"
Exit Sub
Else
txtsql = txtsql & " " & RelationName(cboRelation1.Text) & " " & field(cboField2.Text) & " " & cboOpsign2.Text & "'" & Trim(txtContent2.Text) & "'"
'第三组判断
If cboRelation2.Text <> "" Then
Select Case Trim(cboField3.Text)
'判断是否为日期型
Case "上机日期"
DTPicker3.MaxDate = Date
If Format(DTPicker3.Value, "yyyy-mm-dd") > Format(DTPicker3.MaxDate, "yyyy-mm-dd") Then
MsgBox "您选择的日期不能大于当前日期", 0 + 48, "提示"
Exit Sub
End If
txtContent3.Text = Format(DTPicker3.Value, "yyyy-mm-dd")
Case "下机日期"
DTPicker3.MaxDate = Date
If Format(DTPicker3.Value, "yyyy-mm-dd") > Format(DTPicker3.MaxDate, "yyyy-mm-dd") Then
MsgBox "您选择的日期不能大于当前日期", 0 + 48, "提示"
Exit Sub
End If
txtContent3.Text = Format(DTPicker3.Value, "yyyy-mm-dd")
'判断是否为时间类型
Case "上机时间"
txtContent3.Text = Format(DTPicker3.Value, "hh:mm:ss")
Case "下机时间"
txtContent3.Text = Format(DTPicker3.Value, "hh:mm:ss")
'为其他
If Trim(txtContent3.Text) = "" Then
txtContent3.SetFocus
End If
End Select
If Trim(cboField3.Text) = "" Or Trim(cboOpsign3.Text) = "" Or Trim(txtContent3.Text) = "" Then
MsgBox "请将第三行内容填写完整", 0, "温馨提示"
Exit Sub
Else
txtsql = txtsql & " " & RelationName(cboRelation2.Text) & " " & field(cboField3.Text) & " " & cboOpsign3.Text & "'" & Trim(txtContent3.Text) & "'"
End If
End If
End If
End If
End If
'返回值查询，填写表头
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF Then
MsgBox "无数据，请重新填写", vbInformation
cboField1.SetFocus
cboField1.Text = ""
cboOpsign1.Text = ""
txtContent1.Text = ""
cboField2.Text = ""
cboOpsign2.Text = ""
txtContent2.Text = ""
cboField3.Text = ""
cboOpsign3.Text = ""
txtContent3.Text = ""
MSHFlexGrid1.Clear
Else
'将数据库中查询到的内容填写到mshflexgrid表中
Do While Not mrc.EOF
With MSHFlexGrid1
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = Trim(mrc.fields(1)) & ""
.TextMatrix(.Rows - 1, 1) = Trim(mrc.fields(3)) & ""
.TextMatrix(.Rows - 1, 2) = Trim(mrc.fields(6)) & ""
.TextMatrix(.Rows - 1, 3) = Trim(mrc.fields(7)) & ""
.TextMatrix(.Rows - 1, 4) = Trim(mrc.fields(8)) & ""
.TextMatrix(.Rows - 1, 5) = Trim(mrc.fields(9)) & ""
.TextMatrix(.Rows - 1, 6) = Trim(mrc.fields(11)) & ""
.TextMatrix(.Rows - 1, 7) = Trim(mrc.fields(12)) & ""
.TextMatrix(.Rows - 1, 8) = Trim(mrc.fields(13)) & ""
mrc.MoveNext
End With
Loop
End If
End Sub
Private Sub cmdDelete_Click()
MSHFlexGrid1.Clear
End Sub
Private Sub cmdExcel_Click()
Dim xlapp As New Excel.Application '声明Excel对象
Dim xlbook As Excel.Workbook '声明工作簿对象
Dim xlsheet As Excel.Worksheet '声明工作表单
' Dim i As Integer
Dim j As Integer
If MSHFlexGrid1.Text = "" Then '判断是否有记录可以导出
MsgBox "没有记录可导出！", 0 + 48, "警告"
Exit Sub
Else
Set xlapp = CreateObject("excel.application") '调用excel程序
Set xlbook = xlapp.Workbooks.Add(1) '创建新的空白薄
Set xlsheet = Excel.ActiveWorkbook.ActiveSheet ' 创建新的工作表单
For i = 0 To MSHFlexGrid1.Rows - 1 '填入数据
For j = 0 To MSHFlexGrid1.Cols - 1
xlsheet.Cells(i + 1, j + 1) = MSHFlexGrid1.TextMatrix(i, j) 'cell(a,b)表示a行，b列
Next j
Next i
xlapp.Visible = True '显示excel表格
Set xlapp = Nothing '交还控制给Excel
End If
End Sub