VB查询数据库之结账——机房收费系统总结（五）

对于机房收费的结账，我感觉是所有窗体中，最难的一个。这个窗体我真的做了好多天。它的难度系数我感觉是最高的。

首先，你要理清上机时间和收费标准的关系，在预备时间中，是不收费的。

其次，在超过预备时间，一个单位时间之内，收一个费用。在一个单位时间到两个单位时间内，收两个单位时间的费用。

然后，在结账窗口，链接数据库，显示出所有该用户未结账的信息。

最后，在点击结账时，这个用户的所有未结账信息都结账，并写入数据库。结账窗口查询类信息都为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