📄 frmshowstu.frm
字号:
Dim sqlCheck2 As String
sqlCheck2 = "select count(准考证号) as 已招人数 from 已录取考生表 where 院系= '" _
& txtDept.Text & "' and 省份='" & Text1(5) & "'"
rs_check2.CursorLocation = adUseClient
rs_check2.Open sqlCheck2, conn, adOpenStatic, adLockOptimistic
Dim sumAdmit As Integer
If rs_check2.EOF = True Then
sumAdmit = 0
Else
sumAdmit = rs_check2.Fields(0) '已录取考生表中该院系在该省招生人数
End If
rs_check2.Close
'检测是否名额已满
If (sumPlan - sumAdmit) = 0 Then
MsgBox "该院系在该省录取名额已满，无法再录取！", vbOKOnly + vbInformation, "注意"
Exit Sub
End If
'录取前提示用户是否确实录取
Dim answer As String
answer = MsgBox("确定要录取吗？", vbYesNo, "")
'确实删除
If answer = vbYes Then
Dim sqlAdmit As String
sqlAdmit = "select * from 已录取考生表"
rs_Admit.Open sqlAdmit, conn, adOpenStatic, adLockPessimistic
rs_Admit.AddNew
rs_Admit.Fields(0) = Text1(0).Text
rs_Admit.Fields(1) = Text1(1).Text
rs_Admit.Fields(2) = txtDept.Text
rs_Admit.Fields(3) = Text1(5).Text
rs_Admit.Fields(4) = Text8(5).Text
'更新记录后关闭它
rs_Admit.Update
rs_Admit.Close
'提示用户录取成功
MsgBox "录取成功！", vbOKOnly + vbInformation, ""
Else
Exit Sub
End If
End Sub
Private Sub cmdAfterward_Click()
'先移动rs_Stu记录到后一条
rs_Stu.MoveNext
rs_Wish.MoveNext
'设置前一条和第一条按钮可用
cmdForward.Enabled = True
cmdFirst.Enabled = True
'如果已经是最后一条记录，则提示用户
If rs_Stu.EOF = True Or rs_Wish.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“后一条”和最后一条按钮不可用
cmdAfterward.Enabled = False
cmdLast.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到后一条记录，并且显示之
Else
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
'移动其他各表游标到该记录并显示
rs_Grade.MoveNext
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
' rs_Wish.MoveNext
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
rs_Study.MoveNext
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
rs_Relation.MoveNext
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
End If
End Sub
Private Sub cmdChange_Click()
If cmdChange.Caption = "修 改" Then
'设置相应的按钮不可用
cmdDel.Enabled = False
'设置修改按钮为确定按钮
cmdChange.Caption = "确 定"
'设置各个textbox控件可写
For i = 0 To 7
Text1(i).Enabled = True
Next i
For i = 0 To 7
Text8(i).Enabled = True
Next i
For i = 0 To 5
Text9(i).Enabled = True
Next i
For i = 0 To 3
Text10(i).Enabled = True
Next i
For i = 0 To 13
Text11(i).Enabled = True
Next i
ElseIf cmdChange.Caption = "确 定" Then
'设置修改、删除按钮可用
cmdChange.Enabled = True
cmdDel.Enabled = True
cmdChange.Caption = "修 改"
'如果单科分数改动，则需要修改总分
'计算总成绩
Dim sum As Integer
sum = 0
For i = 0 To 4
sum = sum + Val(Text8(i).Text)
Next i
'总分等于各科分数之和
Text8(5).Text = sum
rs_Stu.Update
rs_Grade.Update
rs_Wish.Update
rs_Study.Update
rs_Relation.Update
'保存了修改结果之后，需要使各个TextBox控件设为不可写
For i = 0 To 7
Text1(i).Enabled = False
Next i
For i = 0 To 7
Text8(i).Enabled = False
Next i
For i = 0 To 5
Text9(i).Enabled = False
Next i
For i = 0 To 3
Text10(i).Enabled = False
Next i
For i = 0 To 13
Text11(i).Enabled = False
Next i
End If
End Sub
Private Sub cmdDel_Click()
'当单击删除记录时，需要弹出一个提示框，警告用户
Dim answer As String
answer = MsgBox("确定要删除吗？", vbYesNo, "")
'确实删除
If answer = vbYes Then
rs_Stu.Delete '删除当前记录
rs_Stu.Update '更新删除
rs_Grade.Delete
rs_Grade.Update
rs_Wish.Delete
rs_Wish.Update
rs_Study.Delete
rs_Study.Update
rs_Relation.Delete
rs_Relation.Update
MsgBox "成功删除！", vbOKOnly + vbExclamation, ""
'设置删除按钮不可用
cmdDel.Enabled = False
Else
Exit Sub
End If
'删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录
'先移动rs_Stu记录到后一条
rs_Stu.MoveNext
rs_Grade.MoveNext
rs_Wish.MoveNext
rs_Study.MoveNext
rs_Relation.MoveNext
If rs_Stu.EOF Then
rs_Stu.MoveLast
rs_Grade.MoveLast
rs_Wish.MoveLast
rs_Study.MoveLast
rs_Relation.MoveLast
End If
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFirst_Click()
'先移动rs_Stu记录到第一条
rs_Stu.MoveFirst
'同时需要设置相应按钮为不可用和不可用
cmdForward.Enabled = False
cmdFirst.Enabled = False
cmdAfterward.Enabled = True
cmdLast.Enabled = True
'如果已经是第一条记录，则提示用户
If rs_Stu.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是，则个数据表的记录位置移到第一条记录，并且显示之
Else
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
'移动其他各表游标到该记录并显示
rs_Grade.MoveFirst
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
rs_Wish.MoveFirst
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
rs_Study.MoveFirst
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
rs_Relation.MoveFirst
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
End If
End Sub
Private Sub cmdForward_Click()
'先移动rs_Stu记录到前一条
rs_Stu.MovePrevious
rs_Grade.MovePrevious
'设置后一条和最后一条按钮可用
cmdAfterward.Enabled = True
cmdLast.Enabled = True
'如果已经是第一条记录，则提示用户
If rs_Stu.BOF = True Or rs_Grade.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“前一条”和第一条按钮不可用
cmdForward.Enabled = False
cmdFirst.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到前一条记录，并且显示之
Else
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
'移动其他各表游标到该记录并显示
' rs_Grade.MovePrevious
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
rs_Wish.MovePrevious
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
rs_Study.MovePrevious
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
rs_Relation.MovePrevious
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
End If
End Sub
Private Sub cmdLast_Click()
'先移动rs_Stu记录到最后一条
rs_Stu.MoveLast
'同时需要设置后一条和最后一条按钮不可用,第一条和前一条按钮可用
cmdAfterward.Enabled = False
cmdLast.Enabled = False
cmdFirst.Enabled = True
cmdForward.Enabled = True
'如果已经是最后一条记录，则提示用户
If rs_Stu.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是，则个数据表的记录位置移到最后一条记录，并且显示之
Else
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
'移动其他各表游标到该记录并显示
rs_Grade.MoveLast
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
rs_Wish.MoveLast
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
rs_Study.MoveLast
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
rs_Relation.MoveLast
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
End If
End Sub
Private Sub cmdQuery_Click()
Dim Markstu As String
Dim strInput As String '用于保存用户输入的考生准考证号
Dim lonInput As Long '用于保存转换成数字后的考生准考证号
strInput = InputBox("请输入要查询的考生准考证号：", "输入准考证号")
If Len(strInput) = 0 Then
MsgBox "没有输入准考证号，取消查询！", vbOKOnly + vbInformation, "注意"
Else
lonInput = Val(strInput)
Markstu = rs_Stu.Bookmark
'使用find 方法查找记录
rs_Stu.Find "准考证号 like '" & lonInput & "'"
'如果没有找到则提示用户
If rs_Stu.EOF Then
MsgBox "对不起，没有找到你所要的记录！", vbOKOnly + vbInformation, "注意"
Exit Sub
Else
'如果找到则显示该记录并且相应各表游标都移到该记录
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
'移动其他各表游标到该记录并显示
rs_Grade.Find "准考证号 like '" & lonInput & "'"
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
rs_Wish.Find "准考证号 like '" & lonInput & "'"
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
rs_Study.Find "准考证号 like '" & lonInput & "'"
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
rs_Relation.Find "准考证号 like '" & lonInput & "'"
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
End If
End If
End Sub
Private Sub Form_Load()
Dim X0 As Long
Dim Y0 As Long
'让窗体居中
X0 = Screen.Width
Y0 = Screen.Height
X0 = (X0 - Me.Width) / 2
Y0 = (Y0 - Me.Height) / 2
Me.Move X0, Y0
Dim sql_Stu As String
Dim sql_Grade As String
Dim sql_Wish As String
Dim sql_Study As String
Dim sql_Relation As String
Dim i As Integer
'在from_laod（)方法中打开5个考生信息表
sql_Stu = "select * from 考生基本信息表"
rs_Stu.CursorLocation = adUseClient
rs_Stu.Open sql_Stu, conn, adOpenStatic, adLockOptimistic
For i = 0 To 7
Text1(i).Text = rs_Stu.Fields(i)
Next i
sql_Grade = "select * from 考生成绩表"
rs_Grade.CursorLocation = adUseClient
rs_Grade.Open sql_Grade, conn, adOpenStatic, adLockOptimistic
For i = 0 To 7
Text8(i).Text = rs_Grade.Fields(i + 2)
Next i
sql_Wish = "select * from 考生志愿表"
rs_Wish.CursorLocation = adUseClient
rs_Wish.Open sql_Wish, conn, adOpenStatic, adLockOptimistic
For i = 0 To 5
Text9(i).Text = rs_Wish.Fields(i + 2)
Next i
sql_Study = "select * from 考生简历表"
rs_Study.CursorLocation = adUseClient
rs_Study.Open sql_Study, conn, adOpenStatic, adLockOptimistic
For i = 0 To 3
Text10(i).Text = rs_Study.Fields(i + 2)
Next i
sql_Relation = "select * from 考生亲属表"
rs_Relation.CursorLocation = adUseClient
rs_Relation.Open sql_Relation, conn, adOpenStatic, adLockOptimistic
For i = 0 To 13
Text11(i).Text = rs_Relation.Fields(i + 2) & ""
Next i
'下面需要设置各个textbox控件不可修改
For i = 0 To 7
Text1(i).Enabled = False
Next i
For i = 0 To 7
Text8(i).Enabled = False
Next i
For i = 0 To 5
Text9(i).Enabled = False
Next i
For i = 0 To 3
Text10(i).Enabled = False
Next i
For i = 0 To 13
Text11(i).Enabled = False
Next i
End Sub
Private Sub Form_Unload(Cancel As Integer)
rs_Stu.Close
rs_Grade.Close
rs_Wish.Close
rs_Study.Close
rs_Relation.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -