機房收費系統——組合查詢窗體
阿新 • • 發佈：2018-11-10
組合查詢
這部分也是機房收費系統中的重難點，它的難點在於查詢語句和它的邏輯思路：
我們以上機記錄查詢窗體為例來看一下：首先我們會發現這個窗體的欄位名中不光有卡號、姓名，而且還有上機日期，上機時間，下機日期和下機時間，所以這個時候我們就需要用一個時間控制元件來減輕使用者的負擔！
為了便於和資料庫的連線，我們需要定義以下兩個函式：
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