对于机房收费的结账，我感觉是所有窗体中，最难的一个。这个窗体我真的做了好多天。它的难度系数我感觉是最高的。
首先，你要理清上机时间和收费标准的关系，在预备时间中，是不收费的。
其次，在超过预备时间，一个单位时间之内，收一个费用。在一个单位时间到两个单位时间内，收两个单位时间的费用。
然后，在结账窗口，链接数据库，显示出所有该用户未结账的信息。
最后，在点击结账时，这个用户的所有未结账信息都结账，并写入数据库。结账窗口查询类信息都为0。并把结账信息写入结账表。已被制作报表使用。
在做结账窗体时，主要是理清思路，这样做起来就容易很多了。我把我的结账窗体和代码放在下面，不做详细的解说，只是给自己留个思路，读者一个方法。
代码仅供参考：
Option Explicit
Dim c0 As Variant '用于把最新数据存放到表
Dim c1 As Variant
Dim c2 As Variant
Dim c3 As Variant
Dim c4 As Variant
Dim c5 As Variant Private Sub cboUser_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrcU As ADODB.Recordset '使得 用户名的卡号 与 姓名 一致
txtSQL = "select UserName from User_Info where UserID='" & cboUser.Text & "'"
Set mrcU = ExecuteSQL(txtSQL, MsgText) cboUserName.Text = mrcU.Fields(0)
mrcU.Close Call viewdate '更新汇总信息
End Sub Private Sub cboUserName_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrcU As ADODB.Recordset '用户名的卡号 与 姓名 一致
txtSQL = "select UserID from User_Info where UserName='" & cboUserName.Text & "'"
Set mrcU = ExecuteSQL(txtSQL, MsgText) cboUser.Text = mrcU.Fields(0)
mrcU.Close Call viewdate '更新信息
End Sub Private Sub viewdate() '根据已经选择好人员信息来修改SSTab里面的汇总信息
Dim txtSQL As String
Dim MsgText As String
Dim mrcSD As ADODB.Recordset
Dim mrcRC As ADODB.Recordset
Dim mrcCC As ADODB.Recordset
Dim RechargeCash As Variant '用于存储，充值的 所有金额
Dim cancelCash As Variant '用于存储，退钱的 所有金额 '把他的所有信息，未结账的显示出来
'txtSQL = "select studentNo,cardno,date,time from student_Info where Ischeck = '未结帐' and UserID='" & cboUser.Text & "'"
'Set mrcSD = ExecuteSQL(txtSQL, MsgText)'由于有空格，找了好久才找到 txtSQL = "select studentNo,cardno,date,time from student_Info where Ischeck='未结账' and UserID='" & cboUser.Text & "'"
Set mrcSD = ExecuteSQL(txtSQL, MsgText) MfgBugCard.Rows = mrcSD.RecordCount + 1 With MfgBugCard
.Row = 0
While mrcSD.EOF = False
.Row = .Row + 1
.TextMatrix(.Row, 0) = " " & mrcSD.Fields(0)
.TextMatrix(.Row, 1) = " " & mrcSD.Fields(1)
.TextMatrix(.Row, 2) = " " & mrcSD.Fields(2)
.TextMatrix(.Row, 3) = " " & mrcSD.Fields(3)
mrcSD.MoveNext
Wend
End With '把该操作员的所有未结账的充值信息汇总到表格，一个注册信息对应一个充值信息
txtSQL = "select studentNo,cardno,addmoney,date,time from ReCharge_Info where status='未结账' and UserID='" & cboUser.Text & "'"
Set mrcRC = ExecuteSQL(txtSQL, MsgText) MfgRecharge.Rows = mrcRC.RecordCount + 1 With MfgRecharge
.Row = 0
While Not mrcRC.EOF
.Row = .Row + 1
.TextMatrix(.Row, 0) = mrcRC.Fields(0)
.TextMatrix(.Row, 1) = mrcRC.Fields(1)
.TextMatrix(.Row, 2) = mrcRC.Fields(2)
.TextMatrix(.Row, 3) = mrcRC.Fields(3)
.TextMatrix(.Row, 4) = mrcRC.Fields(4)
RechargeCash = RechargeCash + mrcRC.Fields(2)
mrcRC.MoveNext
Wend
End With '把所有信息汇总到表格
txtSQL = "select studentNo,cardNo,date,time,cancelcash from CancelCard_Info where Ischeck='未结账' and UserID='" & cboUser.Text & "'"
Set mrcCC = ExecuteSQL(txtSQL, MsgText) MfgCancelCard.Rows = mrcCC.RecordCount + 1 With MfgCancelCard
.Row = 0 While mrcCC.EOF = False
.Row = .Row + 1
.TextMatrix(.Row, 0) = " " & mrcCC.Fields(0)
.TextMatrix(.Row, 1) = " " & mrcCC.Fields(1)
.TextMatrix(.Row, 2) = " " & mrcCC.Fields(2)
.TextMatrix(.Row, 3) = " " & mrcCC.Fields(3)
.TextMatrix(.Row, 4) = " " & mrcCC.Fields(4)
cancelCash = cancelCash + mrcCC.Fields(4)
mrcCC.MoveNext
Wend
End With '然后，把操作员 的所有统计 信息 汇总 到 汇总列表
txtSaleCard = mrcSD.RecordCount
txtCancelCard = mrcCC.RecordCount
txtRechargeCash = RechargeCash
txtCancelCash = cancelCash
txtSumCard = Val(txtSaleCard.Text) - Val(txtCancelCard.Text)
txtSumCash = Val(txtRechargeCash.Text) - Val(txtCancelCash.Text) mrcSD.Close '关闭释放空间
mrcRC.Close
mrcCC.Close
End Sub Private Sub cmdCheckOut_Click() '把该操作员 有关的 未结账信息 修改成 已结账，------并写报表
Dim txtSQL As String
Dim MsgText As String
Dim mrcSD As ADODB.Recordset
Dim mrcRC As ADODB.Recordset
Dim mrcCC As ADODB.Recordset
Dim mrcCO As ADODB.Recordset txtSQL = "select Ischeck from student_Info where Ischeck='未结账' and UserID='" & cboUser.Text & "'"
Set mrcSD = ExecuteSQL(txtSQL, MsgText) txtSQL = "select status from Recharge_Info where status='未结账' and UserID='" & cboUser.Text & "'"
Set mrcRC = ExecuteSQL(txtSQL, MsgText) txtSQL = "select Ischeck from CancelCard_Info where Ischeck='未结账' and UserId='" & cboUser.Text & "'"
Set mrcCC = ExecuteSQL(txtSQL, MsgText) While mrcSD.EOF = False '修改数据库 并且 更新
mrcSD.Fields(0) = "已结账"
mrcSD.Update '更新数据库
mrcSD.MoveNext
Wend While mrcRC.EOF = False
mrcRC.Fields(0) = "已结帐"
mrcRC.Update
mrcRC.MoveNext Wend While mrcCC.EOF = False
mrcCC.Fields(0) = "已结帐" mrcCC.Update
mrcCC.MoveNext
Wend mrcSD.Close '关闭释放空间
mrcRC.Close
mrcCC.Close '记录修改成功 将刚才的操作写入 日报表
Call ReportDay
Call ReportSum MsgBox "结账成功", vbOKOnly + vbInformation, "提示" Dim mrcU As ADODB.Recordset
'使得 用户名的卡号 与 姓名 一致
txtSQL = "select UserID from User_Info where UserName='" & cboUserName.Text & "'"
Set mrcU = ExecuteSQL(txtSQL, MsgText) cboUser.Text = mrcU.Fields(0)
mrcU.Close Call viewdate '更新 汇总信息 End Sub Private Sub Form_Load()
Dim txtSQL As String
Dim MsgText As String
Dim mrcU As ADODB.Recordset SSTab.Tab = 0 '设置 刚刚载入窗体的时候 的 选项卡位置 '初始化 表格 的标题
With MfgBugCard
.TextMatrix(0, 0) = "学号"
.TextMatrix(0, 1) = "卡号"
.TextMatrix(0, 2) = "日期"
.TextMatrix(0, 3) = "时间"
End With With MfgRecharge
.TextMatrix(0, 0) = "学号"
.TextMatrix(0, 1) = "卡号"
.TextMatrix(0, 2) = "充值金额"
.TextMatrix(0, 3) = "日期"
.TextMatrix(0, 4) = "时间"
End With With MfgCancelCard
.TextMatrix(0, 0) = "学号"
.TextMatrix(0, 1) = "卡号"
.TextMatrix(0, 2) = "日期"
.TextMatrix(0, 3) = "时间"
.TextMatrix(0, 4) = "退卡金额"
End With '把数据库中 的 操作员的 卡号 和 姓名 提取出来 供选择
txtSQL = "select UserID,UserName from User_Info "
Set mrcU = ExecuteSQL(txtSQL, MsgText) While mrcU.EOF = False
cboUser.AddItem Trim(mrcU.Fields(0))
cboUserName.AddItem Trim(mrcU.Fields(1))
mrcU.MoveNext
Wend
mrcU.Close End Sub Private Sub SSTab_Click(PreviousTab As Integer) '点击退出按钮，卸载该窗体
Select Case SSTab.Tab
Case 4
Unload Me
End Select
End Sub '写报表信息
Private Sub ReportDay()
Dim txtSQL As String
Dim MsgText As String
Dim mrcCD As ADODB.Recordset '用于写 今日的 账单 Dim mrcSD As ADODB.Recordset '用于找出 上期 和 本期的充值卡余额
Dim mrcRC As ADODB.Recordset '用于找出 当日的 充值金额
Dim mrcL As ADODB.Recordset '用于找出 当日的 消费金额
Dim mrcCC As ADODB.Recordset '用于找出 当日的 退卡金额 Dim CardCash As Double '对应 本期消费金额
Dim RechargeCash As Double '对应 本日充值余额
Dim lineCash As Double '对应 本日消费金额
Dim cancelCash As Double '对应 本日退卡金额 txtSQL = "select * from CheckDay_Info" '等待写入
Set mrcCD = ExecuteSQL(txtSQL, MsgText) txtSQL = "select sum(cash) from student_Info where status='使用'"
Set mrcSD = ExecuteSQL(txtSQL, MsgText) '存放 本期充值卡余额 txtSQL = "select sum(addmoney) from ReCharge_Info where date='" & Date & "'"
Set mrcRC = ExecuteSQL(txtSQL, MsgText) '存放 本日充值金额 txtSQL = "select sum(consume) from Line_Info where offdate='" & Date & "'"
Set mrcL = ExecuteSQL(txtSQL, MsgText) '存放 本日消费金额 txtSQL = "select sum(CancelCash) from CancelCard_Info where date='" & Date & "'"
Set mrcCC = ExecuteSQL(txtSQL, MsgText) '存放 本日退卡金额 '逐一判断 记录集合 为空的情况。如果查询结果为空 则赋值为0
If IsNull(mrcSD.Fields(0).Value) Then
CardCash = 0
Else
CardCash = mrcSD.Fields(0)
End If If IsNull(mrcRC.Fields(0).Value) Then
RechargeCash = 0
Else
RechargeCash = mrcRC.Fields(0)
End If If IsNull(mrcL.Fields(0).Value) Then
lineCash = 0
Else
lineCash = mrcL.Fields(0)
End If If IsNull(mrcCC.Fields(0).Value) Then
cancelCash = 0
Else
cancelCash = mrcCC.Fields(0)
End If mrcCD.AddNew
mrcCD.Fields(4) = Val(CardCash) + Val(lineCash) + Val(cancelCash) - Val(RechargeCash)
mrcCD.Fields(1) = Val(RechargeCash)
mrcCD.Fields(2) = Val(lineCash)
mrcCD.Fields(3) = Val(cancelCash)
mrcCD.Fields(0) = Val(CardCash)
mrcCD.Fields(5) = Date c0 = mrcCD.Fields(0)
c1 = mrcCD.Fields(1)
c2 = mrcCD.Fields(2)
c3 = mrcCD.Fields(3)
c4 = mrcCD.Fields(4)
c5 = mrcCD.Fields(5) mrcCD.Update
mrcCD.Close End Sub Private Sub ReportSum()
Dim txtSQL As String
Dim MsgText As String
Dim mrcCD As ADODB.Recordset
Dim mrcCS As ADODB.Recordset txtSQL = "select * from CheckDay_Info where date='" & Date & "'"
Set mrcCD = ExecuteSQL(txtSQL, MsgText) txtSQL = "select * from checkWeek_Info where date='" & Date & "'"
Set mrcCS = ExecuteSQL(txtSQL, MsgText) '如果 总报表中 没有数据，那么把日汇总表 的内容写入
mrcCS.AddNew
mrcCS.Fields(0) = mrcCD.Fields(0)
mrcCS.Fields(1) = mrcCD.Fields(1)
mrcCS.Fields(2) = mrcCD.Fields(2)
mrcCS.Fields(3) = mrcCD.Fields(3)
mrcCS.Fields(4) = mrcCD.Fields(4)
mrcCS.Fields(5) = mrcCD.Fields(5) mrcCS.Update '更新
mrcCS.Close '释放内存 mrcCD.Close End Sub
版权声明：本文为博主原创文章，未经博主允许不得转载。