一、逻辑图
先理清楚上下机的逻辑过程，再去实现代码
①上机模块
②下机模块
二、代码
①上机模块
Private Sub cmdOnLine_Click()
Dim mrc As ADODB.Recordset
Dim msgtext As String
Dim txtsql As String
Dim mrcBasicData As ADODB.Recordset
Dim mrcline As ADODB.Recordset
Dim mrccash As ADODB.Recordset
txtDownTime.Text = ""
txtDownTime.Text = ""
txtBalance.Text = ""
txtExpenseTime.Text = ""
txtExpenseCash.Text = ""
'判断是否为空
If Not Testtxt(txtCardNo.Text) Then
MsgBox "请输入上机卡号！",vbOKOnly + vbExclamation,"提示"
txtCardNo.SetFocus
Exit Sub
Else
If Not IsNumeric(Trim(txtCardNo.Text)) Then
MsgBox "卡号必须输入数字！","提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
End If
'判断卡号是否注册
txtsql = "select*from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
If mrc.BOF And mrc.EOF Then
MsgBox "该卡号未注册，请先注册信息！","提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
If Trim(mrc.Fields(10)) = "不使用" Then
MsgBox "该卡已经退卡",vbOKCancel + vbInformation,"提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
End If
'查BasicData_Info，判断余额是否小于最小金额
txtsql = "select*from BasicData_Info"
Set mrcBasicData = Executesql(txtsql,msgtext)
mrcBasicData.MoveFirst
If Val(mrc.Fields(7)) < Val(mrcBasicData.Fields(5)) Then
MsgBox "余额不足，请充值后上机","提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Else
'查OnLine_Info,看该卡是否在上机
txtsql = "select*from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
If mrc.EOF = False Then
MsgBox "该卡正在上机，不能重复上机！"
txtCardNo.Text = mrc.Fields(0)
txtType.Text = mrc.Fields(1)
txtStudentNo.Text = mrc.Fields(2)
txtName.Text = mrc.Fields(3)
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(5)
txtOnDate.Text = mrc.Fields(6)
txtOnTime.Text = mrc.Fields(7)
txtsql = "select*from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrccash = Executesql(txtsql,msgtext)
txtBalance.Text = mrccash!Cash
Else
'正常上机，显示卡号信息
txtsql = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
If mrc.EOF = False Then
txtCardNo.Text = Trim(mrc.Fields(0))
txtStudentNo.Text = Trim(mrc.Fields(1))
txtName.Text = Trim(mrc.Fields(2))
txtSex.Text = mrc.Fields(3)
txtDepartment.Text = mrc.Fields(4)
txtType.Text = mrc.Fields(14)
txtOnDate.Text = Date
txtOnTime.Text = Time
txtBalance.Text = mrc!Cash
'更新Line_Info数据
txtsql = "select * from Line_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrcline = Executesql(txtsql,msgtext)
mrcline.AddNew
mrcline.Fields(1) = Trim(txtCardNo.Text)
mrcline.Fields(2) = Trim(txtStudentNo.Text)
mrcline.Fields(3) = Trim(txtName.Text)
mrcline.Fields(4) = Trim(txtDepartment.Text)
mrcline.Fields(5) = Trim(txtSex.Text)
mrcline.Fields(6) = Trim(txtOnDate.Text)
mrcline.Fields(7) = Trim(txtOnTime.Text)
On Error Resume Next
mrcline.Fields(12) = Trim(mrc.Fields(7))
mrcline.Fields(13) = "正常上机"
mrcline.Fields(14) = Trim(Environ("username"))
mrcline.Update
'更新OnLine_Info数据
txtsql = "select * from OnLine_Info"
Set mrc = Executesql(txtsql,msgtext)
mrc.AddNew
mrc.Fields(0) = Trim(txtCardNo.Text)
mrc.Fields(1) = Trim(txtType.Text)
mrc.Fields(2) = Trim(txtStudentNo.Text)
mrc.Fields(3) = Trim(txtName.Text)
mrc.Fields(4) = Trim(txtDepartment.Text)
mrc.Fields(5) = Trim(txtSex.Text)
mrc.Fields(6) = Date
mrc.Fields(7) = Time
mrc.Fields(8) = Trim(Environ("username"))
mrc.Update
If mrc.EOF = True Then
Label18.Caption = 0
Else
Label18.Caption = mrc.RecordCount
End If
End If
End If
End If
End Sub②下机模块
'判断卡号是否为空，判断是否为数字
If Trim(txtCardNo.Text = "") Then
MsgBox "请输入卡号！","提示"
txtCardNo.SetFocus
Exit Sub
Else
If Not IsNumeric(Trim(txtCardNo.Text)) Then
MsgBox "卡号必须输入数字！","提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
End If
'判断卡号是否注册，否则退卡
txtsql = "select*from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
If mrc.BOF And mrc.EOF Then
MsgBox "该卡号未注册，请先注册信息！","提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
If Trim(mrc.Fields(10)) = "不使用" Then
MsgBox "该卡已经退卡","提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
End If
'判断该卡号是否在上机，没有上机不能下机
txtsql = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
If mrc.EOF = True Then
MsgBox "该卡没有上机，不能进行下机处理","警告"
txtCardNo.Text = ""
txtCardNo.SetFocus
txtStudentNo.Text = ""
txtDepartment.Text = ""
txtType.Text = ""
txtName.Text = ""
txtSex.Text = ""
txtOnDate.Text = ""
txtDownDate.Text = ""
txtBalance.Text = ""
txtOnTime.Text = ""
txtDownTime.Text = ""
txtExpenseTime.Text = ""
txtExpenseCash.Text = ""
Exit Sub
End If
'计算所消费的时间（实际花费的时间）
intlinetime = (Date - DateValue(mrc!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc!OnTime))) '时间单位为分钟
txtsql = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
'获得基本表的数据
txtsql = "select * from BasicData_Info"
Set mrcBasicData = Executesql(txtsql,msgtext)
mrcBasicData.MoveFirst
'单位时间的费用 （把固定用户，临时用户单位时间的费用分别赋值给费用）
fixedunit = Val(mrcBasicData.Fields(0)) '把固定用户的金额赋值给变量
temunit = Val(mrcBasicData.Fields(1)) '把临时用户的金额赋值给变量
'判断在线时间是否小于准备时间，若小于则 消费金额0元
If intlinetime <= Val(Trim(mrcBasicData.Fields(4))) Then
txtExpenseCash.Text = "0"
Else
'判断在线时间是否小于最低消费时间，若小于则消费金额为0元
If intlinetime < Val(Trim(mrcBasicData.Fields(3))) Then
txtExpenseCash.Text = "0"
End If
End If
'在线时间大于单位时间，就按有几个单位时间算，固定用户、临时用户
If intlinetime >= Val(Trim(mrcBasicData!leastTime)) And intlinetime And Trim(mrc.Fields(14)) = "固定用户" Then
a = Int(intlinetime / Val(Trim(mrcBasicData!unitTime)))
If a = intlinetime / Trim(mrcBasicData!unitTime) Then
curconsume = a
Else
curconsume = a + 1
End If
txtExpenseCash.Text = Val(curconsume) * Val(fixedunit)
Else
If intlinetime >= Val(Trim(mrcBasicData!leastTime)) And intlinetime And Trim(mrc.Fields(14)) = "临时用户" Then
a = Int(intlinetime / Val(Trim(mrcBasicData!unitTime)))
If a = intlinetime / Trim(mrcBasicData!unitTime) Then
curconsume = a
Else
curconsume = a + 1
End If
txtExpenseCash.Text = Val(curconsume) * Val(temunit)
End If
End If
'更新学生表
txtsql = "select * from student_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
remainCash1 = mrc!Cash - Val(txtExpenseCash.Text)
mrc.Fields(7) = remainCash1
mrc.Update
mrc.Close
'下机显示，更新在线表的信息显示
txtsql = "select * from OnLine_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
Set mrc = Executesql(txtsql,msgtext)
txtOnDate.Text = Trim(mrc.Fields(6))
txtOnTime.Text = Trim(mrc.Fields(7))
txtDownDate.Text = Date
txtDownTime.Text = Time
txtType = Trim(mrc.Fields(1))
txtStudentNo.Text = Trim(mrc.Fields(2))
txtName.Text = Trim(mrc.Fields(3))
txtDepartment.Text = Trim(mrc.Fields(4))
txtSex = Trim(mrc.Fields(5))
txtExpenseTime.Text = intlinetime
txtBalance.Text = remainCash1
'更新上机记录表
txtsql = "select * from Line_Info where ontime= '" & Trim(txtOnTime.Text) & "'"
Set mrcline = Executesql(txtsql,msgtext)
On Error Resume Next
mrcline.Fields(8) = Trim(txtDownDate.Text)
mrcline.Fields(9) = Trim(txtDownTime.Text)
mrcline.Fields(10) = Trim(txtExpenseTime.Text)
mrcline.Fields(11) = Trim(txtExpenseCash.Text)
mrcline.Fields(12) = Trim(txtBalance.Text)
mrcline.Fields(13) = Trim("正常下机")
mrcline.Fields(14) = Trim(Environ("username"))
mrcline.Update
MsgBox "下机成功，欢迎下次再来","提示"
' txtCardNo.Text = ""
' txtStudentNo.Text = ""
' txtDepartment.Text = ""
' txtType.Text = ""
' txtName.Text = ""
' txtSex.Text = ""
' txtOnDate.Text = ""
' txtDownDate.Text = ""
' txtBalance.Text = ""
' txtOnTime.Text = ""
' txtDownTime.Text = ""
' txtExpenseTime.Text = ""
' txtExpenseCash.Text = ""
'删除在线表的信息
mrc.Delete
mrc.Update
Label18.Caption = Str(Int(Label18.Caption) - 1)
End Sub