机房收费系统中一个重要的窗体之一就是结账窗体,因为涉及到数据库中的好多表所以刚开始会觉得很难,其实理清思路后按照自己的思路写完后便觉得没有想象中的那么难!好先来看一下窗体界面:
说明:操作员用户名:combo1,操作员真实姓名:combo2
总售卡数=售卡张数-退卡张数
临时收费金额=临时用户注册和充值的钱
应收金额=充值金额-退卡金额
一开始看到这个界面的控件时不知道是什么控件,但是我记得之前敲百例的时候用过这么一个控件所以我就把之前百例里面的涉及到这个控件的例子找到,知道了它是什么控件!
操作员用户名和操作员真实姓名我本来是从User_Info表里查的,但是师傅说如果有好多操作员打开combox时里面有好多的数据,有的今天就没有登录或做售卡,充值,退卡等的操作的工作所以就没有必要显示!我后来想了想觉得结账是要每天就要结账所以我就打算用worklog_Info这个表但是这个表里没有UserName所以我就在这个表里加了一列。
Private Sub Form_Load() Dim mrc As ADODB.Recordset Dim MsgText As String Dim txtSQL As String Dim i As Integer txtSQL = "select*from worklog_Info where LoginDate= '" & Trim(Date) & "'" & " and level= '操作员' " '今天登录过的操作员 Set mrc = ExecuteSQL(txtSQL, MsgText) For i = 1 To mrc.RecordCount '用户名 Combo1.AddItem mrc.Fields(1) mrc.MoveNext Next i mrc.Close End Sub
Private Sub Combo1_Click() Dim txtSQL, MsgText As String Dim mrc As ADODB.Recordset If Combo1.Text = "" Then MsgBox "请输入操作员用户名!", vbOKOnly + vbExclamation, "警告" Exit Sub End If txtSQL = "select * from worklog_Info where UserID='" & Trim(Combo1.Text) & "'" & " and LoginDate = '" & Trim(Date) & "'" '今天登录过的操作员 Set mrc = ExecuteSQL(txtSQL, MsgText) Combo2.Text = Trim(mrc.Fields(9)) mrc.Close End SubSSTab里就仅列汇总窗体
Private Sub SSTab1_Click(PreviousTab As Integer) Dim txtSQL As String Dim txtSQL1 As String Dim txtSQL2 As String Dim txtSQL3 As String Dim MsgText As String Dim MsgText1 As String Dim Msgtext2 As String Dim msgText3 As String Dim mrc As ADODB.Recordset Dim mrc1 As ADODB.Recordset Dim mrc2 As ADODB.Recordset Dim mrc3 As ADODB.Recordset Dim a, b, c, d As Long Dim i As Integer Select Case SSTab1.Tab '汇总 Case 4 '售卡张数 txtSQL = "select * from student_Info where UserID='" & Trim(Combo1.Text) & "'" & "and Ischeck='未结账'" Set mrc = ExecuteSQL(txtSQL, MsgText) txtsellcard.Text = mrc.RecordCount '退卡数 txtSQL2 = "select * from CancelCard_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='未结账'" Set mrc2 = ExecuteSQL(txtSQL2, Msgtext2) txtcancelcard.Text = mrc2.RecordCount '退卡张数 txtallsellcard.Text = Val(txtsellcard.Text) - Val(txtcancelcard.Text) '总售卡张数 '充值金额 txtSQL1 = "select sum(addmoney) from ReCharge_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='" & "未结账" & "'" Set mrc1 = ExecuteSQL(txtSQL1, MsgText1) If mrc1.EOF And mrc1.BOF Then a = 0 Else If IsNull(Trim(mrc1.Fields(0))) Then a = 0 Else a = mrc1.Fields(0) End If End If txtrecharge.Text = a '退卡金额 txtSQL3 = "select sum(CancelCash) from CancelCard_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='未结账'" Set mrc3 = ExecuteSQL(txtSQL3, msgText3) If mrc3.BOF And mrc3.EOF Then b = 0 Else If IsNull(Trim(mrc3.Fields(0))) Then b = 0 Else b = mrc3.Fields(0) End If End If txtcancelcash.Text = b '临时收费金额 txtSQL = "select sum(addmoney) from ReCharge_Info where UserID='" & Trim(Combo1.Text) & "'" & " and type= '临时用户' " & "and status='未结账'" Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.BOF And mrc.EOF Then c = 0 Else If IsNull(Trim(mrc.Fields(0))) Then c = 0 Else c = mrc.Fields(0) End If End If txttmpcash.Text = c '应收金额 txtallcash.Text = a - b End Select End Sub结账:
Private Sub cmdcheck_Click() Dim txtSQL As String Dim txtSQL1 As String Dim srtsql As String Dim MsgText As String Dim MsgText1 As String Dim Msgtext2 As String Dim mrc As ADODB.Recordset Dim mrc1 As ADODB.Recordset Dim rst As ADODB.Recordset Dim recharge As Long Dim consume As Long Dim returncash As Long Dim profit As Long Dim cash As Long '更新学生表 txtSQL = "select * from student_Info where UserID ='" & Combo1.Text & "'" & "and Ischeck='未结账'" Set mrc = ExecuteSQL(txtSQL, MsgText) Do While Not mrc.EOF mrc!Ischeck = "已结账" mrc.MoveNext Loop mrc.Close '更新充值表 txtSQL1 = "select * from ReCharge_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='未结账'" Set mrc1 = ExecuteSQL(txtSQL1, MsgText1) Do While Not mrc1.EOF mrc1!Status = "已结账" mrc1.MoveNext Loop mrc1.Close '更新退卡表 txtSQL = "select * from CancelCard_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='未结账'" Set mrc = ExecuteSQL(txtSQL, MsgText) Do While Not mrc.EOF mrc!Status = "已结账" mrc.MoveNext Loop mrc.Close '消费金额 txtSQL1 = "select sum(consume)from Line_Info where status = '" & "正常下机" & "'" Set mrc1 = ExecuteSQL(txtSQL1, MsgText1) If mrc1.BOF And mrc1.EOF Then consume = 0 '消费金额 Else If IsNull(Trim(mrc1.Fields(0))) Then consume = 0 Else consume = mrc1.Fields(0) End If End If '当日退卡金额 txtSQL = "select sum(CancelCash) from CancelCard_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='未结账'" Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.BOF And mrc.EOF Then returncash = 0 Else If IsNull(Trim(mrc.Fields(0))) Then returncash = 0 Else returncash = mrc.Fields(0) End If End If '当日充值金额 txtSQL1 = "select sum(addmoney) from Recharge_Info where UserID='" & Trim(Combo1.Text) & "'" & "and status='" & "未结账" & "'" Set mrc1 = ExecuteSQL(txtSQL1, MsgText1) If mrc.EOF And mrc.BOF Then recharge = 0 Else If IsNull(Trim(mrc.Fields(0))) Then recharge = 0 Else recharge = mrc.Fields(0) End If End If profit = Val(recharge - consume - returncash) '本期金额 ' cash= '更新日结账单 srtsql = "select * from CheckDay_Info " Set rst = ExecuteSQL(srtsql, Msgtext2) rst.MoveLast cash = rst.Fields(4) rst.AddNew rst.Fields(0) = cash rst.Fields(1) = recharge rst.Fields(2) = consume rst.Fields(3) = returncash rst.Fields(4) = profit rst.Fields(5) = Date rst.Update rst.Close MsgBox "结账成功!", vbOKOnly + vbInformation, "恭喜您" End Sub其实只要理清关系写的时候就好写了!