📄 xueji.frm
字号:
ForeColor = &H00C000C0&
Height = 495
Left = -70440
TabIndex = 32
Top = 2160
Width = 1575
End
Begin VB.Label Label4
Caption = "班级:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 375
Left = -73560
TabIndex = 31
Top = 2160
Width = 975
End
Begin VB.Label Label3
Caption = "性别:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 495
Left = -66600
TabIndex = 30
Top = 840
Width = 1215
End
Begin VB.Label Label2
Caption = "年龄:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 495
Left = -70320
TabIndex = 29
Top = 840
Width = 1335
End
Begin VB.Label Label1
Caption = "姓名:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 495
Left = -73560
TabIndex = 16
Top = 840
Width = 1335
End
End
End
Attribute VB_Name = "xueji"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public rs As ADODB.Recordset
Private Sub Command2_Click()
Unload Me
MDIFrm.Show
End Sub
Private Sub labeaddxueji_Click()
: On Error Resume Next
Dim r As String
If Trim(txtname) = "" Then
MsgBox "姓名不能为空，请输入姓名！"
txtname = "": txtname.SetFocus
Exit Sub
End If
If Trim(txtage) = "" Or Not IsNumeric(txtage) Then
MsgBox "年龄为空，或有非法字符，请从新输入！"
txtage = "": txtage.SetFocus
Exit Sub
End If
If Trim(txtsex) = "" Then
MsgBox "性别不能为空，请输入性别！"
txtsex.SetFocus
End If
If Trim(txtclass) = "" Then
MsgBox "班级不能为空，请输入班级！"
txtclass.SetFocus
Exit Sub
End If
If Trim(txtborn) = "" Or Not DateValue(txtborn) Then
MsgBox "出生日期不能为空，请输入出生日期！"
txtborn = "": txtborn.SetFocus
Exit Sub
End If
If Trim(txtwhere) = "" Then
MsgBox "生源地不能为空，请输入生源地！"
txtwhere.SetFocus
Exit Sub
End If
If Trim(txtdarpartment) = "" Then
MsgBox "所处系部不能为空，请输入所在系部！"
txtdarpartment = "": txtdarpartment.SetFocus: Exit Sub
Exit Sub
End If
If Trim(txtzhuanye) = "" Then
MsgBox "专业不能为空，请输入专业！"
txtzhuanye.SetFocus
Exit Sub
End If
If Trim(txtjiguan) = "" Then
MsgBox "籍贯不能为空，请输入籍贯！"
txtjiguan.SetFocus
Exit Sub
End If
If Trim(txtnumber) = "" Or Not IsNumeric(txtnumber) Then
MsgBox "学号为空或有非法字符，请重新输入！"
txtnumber = "": txtnumber.SetFocus
Exit Sub
End If
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from 学籍表"
Adodc1.Refresh
Set rs = Adodc1.Recordset
With rs
Do While Not .EOF
If Trim(rs.Fields("学号")) = Trim(txtnumber) Then
r = MsgBox("您输入的学号已经存在,请从新输入!", vbOKCancel + vbExclamation, "提示信息")
If r = vbOK Then
txtnumber = "": txtnumber.SetFocus
Exit Sub
End If
Else
.MoveNext
End If
Loop
.AddNew
.Fields("姓名") = Trim(txtname.Text)
.Fields("年龄") = Trim(txtage.Text)
.Fields("性别") = Trim(txtsex.Text)
.Fields("班级") = Trim(txtclass.Text)
.Fields("出生日期") = Trim(txtborn.Text)
.Fields("生源地") = Trim(txtwhere.Text)
.Fields("所处系部") = Trim(txtdarpartment.Text)
.Fields("专业") = Trim(txtzhuanye)
.Fields("学号") = Trim(txtnumber)
.Fields("籍贯") = Trim(txtjiguan)
.Update
Adodc1.Refresh: DataGrid1.Refresh
r = MsgBox("添加学籍信息成功,是否继续其他操作？", vbOKCancel + vbExclamation, "提示信息")
If r = vbOK Then
txtname = "": txtage = "": txtsex = "": txtclass = "": txtborn = "": txtwhere = ""
txtdarpartment = "": txtzhuanye = "": txtnumber = "": txtjiguan = "": txtname.SetFocus
Exit Sub
End If
End With
End Sub
Private Sub labelcancel_Click()
Unload Me
MDIFrm.Show
End Sub
Private Sub Labelcancel1_Click()
Unload Me
MDIFrm.Show
End Sub
Private Sub Labelcancel2_Click()
Unload Me
MDIFrm.Show
End Sub
Private Sub Labeldel_Click()
Dim sql As String
Dim sqr As String
Dim rs As ADODB.Recordset
Adodc3.CommandType = adCmdText
Adodc3.RecordSource = "select * from 学籍表"
Adodc3.Refresh
Set rs = Adodc3.Recordset
With rs
If Check1.Value = 1 And Check2.Value = 0 And Check3.Value = 0 Then
Do While Not .EOF
If Trim(.Fields("学号")) = Trim(txtnumber2) Then
.Delete
DataGrid1.Refresh
sql = MsgBox("删除学籍信息成功，是否继续删除操作?", vbOKCancel + vbExclamation, "提示信息")
If sql = vbOK Then
Exit Sub
End If
Else
.MoveNext
End If
Loop
MsgBox "没有你要删除的学籍，请从新输入要删除的学籍信息！"
txtnumber2 = "": txtnumber2.SetFocus: Exit Sub
End If
End With
If Check1.Value = 0 And Check2.Value = 1 And Check3.Value = 0 Then
With rs
Do While Not .EOF
If Trim(.Fields("姓名")) = Trim(txtname2) Then
.Delete
Adodc3.Refresh: DataGrid1.Refresh
sql = MsgBox("删除学籍信息成功，是否继续删除操作?", vbOKCancel + vbExclamation, "提示信息")
If sql = vbOK Then
txtname2 = ""
Exit Sub
End If
Else
.MoveNext
End If
Loop
MsgBox "没有你要删除的学籍，请从新输入要删除的学籍信息！"
txtname2 = "": txtname2.SetFocus: Exit Sub
End With
End If
If Check1.Value = 0 And Check2.Value = 0 And Check3.Value = 1 Then
With rs
Do While Not .EOF
If Trim(.Fields("性别")) = Trim(txtsex2) Then
.Delete
DataGrid1.Refresh
sql = MsgBox("删除学籍信息成功，是否继续删除操作?", vbOKCancel + vbExclamation, "提示信息")
If sql = vbOK Then
Exit Sub
End If
Else
.MoveNext
End If
Loop
End With
txtsex2 = "": txtsex2.SetFocus
MsgBox "没有你要删除的学籍，请从新输入要删除的学籍信息！"
txtsex2.SetFocus: Exit Sub
End If
If Check1.Value = 1 And Check2.Value = 1 And Check3.Value = 0 Then
With rs
Do While Not .EOF
If Trim(.Fields("学号")) = Trim(txtnumber2) And Trim(.Fields("姓名")) = Trim(txtname2) And Trim(.Fields("性别")) = Trim(txtsex2) Then
.Delete
DataGrid1.Refresh
sql = MsgBox("删除学籍信息成功，是否继续删除操作?", vbOKCancel + vbExclamation, "提示信息")
If sql = vbOK Then
Exit Sub
End If
Else
.MoveNext
End If
Loop
MsgBox "没有你要删除的学籍，请从新输入要删除的学籍信息！"
txtnumber2 = "": txtnumber2.SetFocus: Exit Sub
End With
End If
If Check1.Value = 0 And Check2.Value = 1 And Check3.Value = 1 Then
With rs
Do While Not .EOF
If Trim(.Fields("姓名")) = Trim(txtname2) And Trim(.Fields("性别")) = Trim(txtname2) Then
.Delete
DataGrid1.Refresh
sql = MsgBox("删除学籍信息成功，是否继续删除操作?", vbOKCancel + vbExclamation, "提示信息")
If sql = vbOK Then
Exit Sub
End If
Else
.MoveNext
End If
Loop
MsgBox "没有你要删除的学籍，请从新输入要删除的学籍信息！"
txtname = ""
txtname2.SetFocus: Exit Sub
End With
End If
End Sub
Private Sub Labelmod_Click()
Dim sql As String
Dim rs As ADODB.Recordset
If Val(txtage1) <= 0 Or Val(txtage1) >= 126 Then
MsgBox "年龄非法输入,请从新输入!"
txtage1 = "": txtage1.SetFocus: Exit Sub
End If
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = "select * from 学籍表 "
Adodc2.Refresh
Set rs = Adodc2.Recordset
With rs
Do While Not .EOF
If Trim(rs.Fields("学号")) = Trim(txtnumber1) Then
.Fields("姓名") = Trim(txtname1.Text)
.Fields("年龄") = Trim(txtage1.Text)
.Fields("性别") = Trim(txtsex1.Text)
.Fields("班级") = Trim(txtclass1.Text)
.Fields("出生日期") = Trim(txtborn1.Text)
.Fields("生源地") = Trim(txtwhere1.Text)
.Fields("所处系部") = Trim(txtdapartment1.Text)
.Fields("专业") = Trim(txtzhuanye1)
.Fields("籍贯") = Trim(txtjiguan1)
.Update
sql = MsgBox("修改学籍信息成功，是否继续其他操作？", vbOKCancel + vbExclamation, "提示信息")
If sql = vbOK Then
txtname1 = "": txtage1 = "": txtsex1 = "": txtclass1 = "": txtborn1 = "": txtwhere1 = ""
txtdapartment1 = "": txtzhuanye1 = "": txtnumber1 = "": txtjiguan1 = "": txtnumber1.SetFocus
DataGrid2.Refresh: Exit Sub
End If
Else
.MoveNext
End If
Loop
sql = MsgBox("输入的学号在记录中不存在或学号为空，请从新输入！", vbRetryCancel, "提示信息")
If sql = vbRetry Then
txtname1 = "": txtage1 = "": txtsex1 = "": txtclass1 = "": txtborn1 = "": txtwhere1 = ""
txtdapartment1 = "": txtzhuanye1 = "": txtnumber1 = "": txtjiguan1 = "": txtnumber1.SetFocus
Exit Sub
End If
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -