选中学生下线这个窗体的思路比较简单,以下是我的流程图。
代码段展示:
根据流程图,我们首先是要选中要下机的学生,所以在MSHFlexGrid1中,选中某一行,这一行要有变色,用来区分是否选中。
Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim col As Integer If MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "??" Then '?判断是否选中这一行,没有选中,点击后即可选中 MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "" For col = 0 To MSHFlexGrid1.Cols - 1 '从第0行到总列数 '恢复颜色为白色 MSHFlexGrid1.col = col MSHFlexGrid1.CellBackColor = vbWhite Next col Else MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "??" '?????? For col = 0 To MSHFlexGrid1.Cols - 1 MSHFlexGrid1.col = col MSHFlexGrid1.CellBackColor = &HFFFF00 Next col End If
如果选中某一行,“选中部分学生下机”按钮为可用,否则为不可用
If MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "√" Then SelStuOffline.Enabled = True Else SelStuOffline.Enabled = False End If
选中学生下机代码
Private Sub SelStuOffline_Click() '选中学生下线
Dim sz(999) As String '用来存储代对号的学号的数组
Dim xh(999) As String '用来存储代对号的行号
Dim txtCash As String '余额
Dim consume As String '存储消费金额
Dim consumtime As String '存储总时间
Dim z As Integer '存储带对号的学号用到的变量
Dim i As Integer '改变颜色时调用的变量
Dim s As Integer '存储带对号的行号用到的变量
Dim j As Integer '行号
Dim t '时间
Dim bob As Boolean '用来标记是否点击显示全部按钮的状态,开始默认为false
Dim txtSQL As String
Dim txtSQL1 As String
Dim Msgtext As String
Dim OnLine As ADODB.Recordset '连接学生表
Dim mrc1 As ADODB.Recordset '代表online表中有时间限制
Dim line As ADODB.Recordset
Dim bas As ADODB.Recordset
Dim stu As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
With MSHFlexGrid1
If .RowSel = 0 Then
MsgBox "请选择要下机的卡号", vbOKOnly + vbExclamation, "提示"
Else
'记录选中下机的卡号,在最后一行加一个对号,将这些记录的所有卡号信息全部存储到sz数组中
i = 0 '数组第一个为0
For j = 1 To .Rows - 1
If .TextMatrix(j, 5) = "√" Then '记录有对号的行号
sz(i) = .TextMatrix(j, 0) '把卡号数据存到sz数组中
xh(i) = Val(j) '把行号存到xh数组中
i = i + 1
End If
Next j
For z = 0 To i - 1
txtSQL = "select * from BasicData_info"
Set bas = ExecuteSQL(txtSQL, Msgtext)
txtSQL = "select * from student_info where cardno= '" & sz(z) & "' and status='" & "使用" & "'"
Set stu = ExecuteSQL(txtSQL, Msgtext)
txtSQL = "select * from OnLine_info where cardno='" & sz(z) & "'"
Set OnLine = ExecuteSQL(txtSQL, Msgtext)
consumtime = DateDiff("n", Trim(OnLine!Date), Now) '计算消费金额
If Val(consumtime) <= Val(bas!preparetime) Then '消费时间少于最少规定的时间,消费金额为0
consume = 0
Else
If Val(consumtime) Mod Val(bas!unitTime) = 0 Then '计算消费时间
t = Int(consumtime / bas!unitTime)
Else
t = Int(consumtime / bas!unitTime) + 1
End If
If stu.EOF Then
MsgBox "此卡号没有注册或已已退卡", vbOKOnly + vbExclamation, "提示"
Exit Sub
Else
'判断是固定用户还是临时用户
If Trim(stu!Type) = Trim("固定用户") Then
consume = t * bas.Fields(0)
Else
consume = t * bas.Fields(1)
End If
End If
End If
txtCash = Val(stu!cash) - consume '计算余额
'更新line表
txtSQL = "select * from Line_info where cardno='" & sz(z) & "' and ondate='" & OnLine!OnDate & "' and ontime='" & OnLine!OnTime & "'"
Set mrc1 = ExecuteSQL(txtSQL, Msgtext)
mrc1.Fields(1) = sz(z)
mrc1.Fields(2) = Trim(stu.Fields(1))
mrc1.Fields(3) = Trim(stu.Fields(2))
mrc1.Fields(4) = Trim(stu.Fields(4))
mrc1.Fields(5) = Trim(stu.Fields(3))
mrc1.Fields(6) = Trim(stu.Fields(6))
mrc1.Fields(7) = Trim(stu.Fields(7))
mrc1.Fields(10) = consumtime
mrc1.Fields(11) = consume
mrc1.Fields(12) = Val(txtCash)
mrc1.Fields(13) = "正常下机"
mrc1.Fields(14) = GetThisComputerName
mrc1.Fields(8) = Date
mrc1.Fields(9) = Time
stu.Close
OnLine.Close
'更新学生表
txtSQL = "select * from student_info where cardno='" & Trim(sz(z)) & "'"
Set mrc2 = ExecuteSQL(txtSQL, Msgtext)
mrc2.Fields(7) = txtCash
mrc2.Update
'更新online表
txtSQL1 = "delete from OnLine_Info where cardno='" & Trim(sz(z)) & "'"
Set OnLine = ExecuteSQL(txtSQL1, Msgtext)
Next z
'更新msflexgrid1界面
For s = 0 To i - 1
If .Rows > 2 Then
.RemoveItem xh(s)
Else
.Clear
.Enabled = False
End If
Next s
End If
End With
End Sub