frmsushe2.frm

用VB实现的一个学生管理系统

 
 txtsex2.Text = Trim(adoRS("Sex"))
 txtname2.Enabled = True
 txtname2.BackColor = &H80000005
a(3) = txtname2.Text
 
 txtname2.Text = Trim(adoRS("Name"))
 txtnumber2.Enabled = True
 txtnumber2.BackColor = &H80000005
 a(4) = txtnumber2.Text

 txtnumber2.Text = Trim(adoRS("ID"))
 Command9.Enabled = True
End If
 If txtnumber1.Text = txtnumber2.Text Or txtnumber2.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber2.Text Then
txtclass2.Text = a(0)
txtsp2.Text = a(1)
txtsex2.Text = a(2)
txtname2.Text = a(3)
txtnumber2.Text = a(4)
 If a(0) = "" Then
 txtclass2.Enabled = False
 txtsp2.Enabled = False
 txtsex2.Enabled = False
 txtname2.Enabled = False
 Command9.Enabled = False
 txtname2.BackColor = &H80000013
txtsex2.BackColor = &H80000013
txtsp2.BackColor = &H80000013
txtclass2.BackColor = &H80000013
End If

 MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"
End If
  Set adoRS = Nothing
  
Case 2
'学生3
If Option1.Value = True Then
 sql = "select * from Student where ID='" & Trim(List1.Text) & "'"
End If
If Option2.Value = True Then
 sql = "select * from Student where Name='" & Trim(List1.Text) & "'"
End If
 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF Then
   MsgBox "对不起，查无此人，请执行系统查询功能，" _
          & vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
          vbInformation + vbOKOnly, "系统提示"
   Exit Sub
Else
 txtclass3.Enabled = True
 txtclass3.BackColor = &H80000005
 a(0) = txtclass3.Text
 
 txtclass3.Text = Trim(adoRS("Class"))
 txtsp3.Enabled = True
 txtsp3.BackColor = &H80000005
 a(1) = txtsp3.Text
 
 txtsp3.Text = Trim(adoRS("Speciality"))
 txtsp3.BackColor = &H80000005
 txtsex3.Enabled = True
 txtsex3.BackColor = &H80000005
 a(2) = txtsex3.Text
 
 txtsex3.Text = Trim(adoRS("Sex"))
 
 txtname3.Enabled = True
 txtname3.BackColor = &H80000005
 a(3) = txtname3.Text

 txtname3.Text = Trim(adoRS("Name"))
 txtnumber3.Enabled = True
 txtnumber3.BackColor = &H80000005
 a(4) = txtnumber3.Text
 txtnumber3.Text = Trim(adoRS("ID"))
 
 Command10.Enabled = True
End If
 If txtnumber1.Text = txtnumber3.Text Or txtnumber2.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber3.Text Then
txtclass3.Text = a(0)
txtsp3.Text = a(1)
txtsex3.Text = a(2)
txtname3.Text = a(3)
txtnumber3.Text = a(4)
 If a(0) = "" Then
 txtclass3.Enabled = False
 txtsp3.Enabled = False
 txtsex3.Enabled = False
 txtname3.Enabled = False
 Command10.Enabled = False
 txtname3.BackColor = &H80000013
txtsex3.BackColor = &H80000013
txtsp3.BackColor = &H80000013
txtclass3.BackColor = &H80000013
End If

 MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"
End If
  Set adoRS = Nothing

Case 3
'学生4
If Option1.Value = True Then
 sql = "select * from Student where ID='" & Trim(List1.Text) & "'"
End If
If Option2.Value = True Then
 sql = "select * from Student where Name='" & Trim(List1.Text) & "'"
End If
 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF Then
   MsgBox "对不起，查无此人，请执行系统查询功能，" _
          & vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
          vbInformation + vbOKOnly, "系统提示"
   Exit Sub
Else
 txtclass4.Enabled = True
 txtclass4.BackColor = &H80000005
 a(0) = txtclass4.Text
 
 txtclass4.Text = Trim(adoRS("Class"))
 txtsp4.Enabled = True
 txtsp4.BackColor = &H80000005
 a(1) = txtsp4.Text
 
 txtsp4.Text = Trim(adoRS("Speciality"))
 txtsp4.BackColor = &H80000005
 txtsex4.Enabled = True
 txtsex4.BackColor = &H80000005
 a(2) = txtsex4.Text
 
 txtsex4.Text = Trim(adoRS("Sex"))
 
 txtname4.Enabled = True
 txtname4.BackColor = &H80000005
 a(3) = txtname4.Text

 txtname4.Text = Trim(adoRS("Name"))
 txtnumber4.Enabled = True
 txtnumber4.BackColor = &H80000005
 a(4) = txtnumber4.Text
 txtnumber4.Text = Trim(adoRS("ID"))
 
 Command11.Enabled = True
End If
 If txtnumber1.Text = txtnumber4.Text Or txtnumber2.Text = txtnumber4.Text Or txtnumber4.Text = txtnumber3.Text Then
txtclass4.Text = a(0)
txtsp4.Text = a(1)
txtsex4.Text = a(2)
txtname4.Text = a(3)
txtnumber4.Text = a(4)
 If a(0) = "" Then
 txtclass4.Enabled = False
 txtsp4.Enabled = False
 txtsex4.Enabled = False
 txtname4.Enabled = False
 Command11.Enabled = False
 txtname4.BackColor = &H80000013
txtsex4.BackColor = &H80000013
txtsp4.BackColor = &H80000013
txtclass4.BackColor = &H80000013
End If

 MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"
End If
  Set adoRS = Nothing


End Select
End Sub

Private Sub Command2_Click()
Unload Me
frmsushe1.Show
End Sub

Private Sub Command3_Click()
Unload Me

End Sub

Private Sub Command4_Click()
 '学生3
sql = ""
 sql = "select * from Student where ID='" & Trim(txtnumber3.Text) & "'"

 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF Then
   MsgBox "对不起，查无此人，请执行系统查询功能，" _
          & vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
          vbInformation + vbOKOnly, "系统提示"
   txtnumber3.SetFocus
   
   txtnumber3.SelStart = 0
   txtnumber3.SelLength = Len(txtnumber3.Text)
   Exit Sub
   ElseIf txtnumber1.Text = txtnumber2.Text Or txtnumber1.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber1.Text Then
   MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"

Else
 txtclass3.Enabled = True
 txtclass3.BackColor = &H80000005
 txtclass3.Text = Trim(adoRS("Class"))
  txtsp3.Enabled = True
 txtsp3.BackColor = &H80000005
 txtsp3.Text = Trim(adoRS("Speciality"))
  txtsex3.Enabled = True
 txtsex3.BackColor = &H80000005

 txtsex3.Text = Trim(adoRS("Sex"))
  txtname3.Enabled = True
 txtname3.BackColor = &H80000005
Command10.Enabled = True
  txtname3.Text = Trim(adoRS("Name"))
End If
  Set adoRS = Nothing

End Sub

Private Sub Command5_Click()
'学生1
 sql = "select * from Student where ID='" & Trim(txtnumber1.Text) & "'"
 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF Then
   MsgBox "对不起，查无此人，请执行系统查询功能，" _
          & vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
          vbInformation + vbOKOnly, "系统提示"
   txtnumber1.SetFocus
   txtnumber1.SelStart = 0
   txtnumber1.SelLength = Len(txtnumber1.Text)
   Exit Sub
ElseIf txtnumber1.Text = txtnumber2.Text Or txtnumber1.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber1.Text Then
   MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"
Else
 txtclass1.Enabled = True
 txtclass1.BackColor = &H80000005
 txtclass1.Text = Trim(adoRS("Class"))
 txtsp1.Enabled = True
 txtsp1.BackColor = &H80000005
 txtsp1.Text = Trim(adoRS("Speciality"))
 txtsp1.BackColor = &H80000005
 txtsex1.Enabled = True
 txtsex1.BackColor = &H80000005
 txtsex1.Text = Trim(adoRS("Sex"))
 txtname1.Enabled = True
 txtname1.BackColor = &H80000005
 txtname1.Text = Trim(adoRS("Name"))
 Command8.Enabled = True
End If
  Set adoRS = Nothing


End Sub

Private Sub Command6_Click()
 '学生2

 sql = ""
 sql = "select * from Student where ID='" & Trim(txtnumber2.Text) & "'"

 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF Then
   MsgBox "对不起，查无此人，请执行系统查询功能，" _
          & vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
          vbInformation + vbOKOnly, "系统提示"
   txtnumber2.SetFocus
   
   txtnumber2.SelStart = 0
   txtnumber2.SelLength = Len(txtnumber2.Text)
   Exit Sub
 ElseIf txtnumber1.Text = txtnumber2.Text Or txtnumber2.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber2.Text Then
   MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"

Else
txtclass2.Enabled = True
 txtclass2.BackColor = &H80000005
 txtclass2.Text = Trim(adoRS("Class"))
  txtsp2.Enabled = True
 txtsp2.BackColor = &H80000005
 txtsp2.Text = Trim(adoRS("Speciality"))
 txtsex2.Enabled = True
 txtsex2.BackColor = &H80000005
 txtsex2.Text = Trim(adoRS("Sex"))
 txtname2.Enabled = True
 txtname2.BackColor = &H80000005
  txtname2.Text = Trim(adoRS("Name"))
  Command9.Enabled = True
End If
  Set adoRS = Nothing
End Sub

Private Sub Command7_Click()
'学生4
 
 sql = ""
  sql = "select * from Student where ID='" & Trim(txtnumber4.Text) & "'"

 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF Then
   MsgBox "对不起，查无此人，请执行系统查询功能，" _
          & vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
          vbInformation + vbOKOnly, "系统提示"
   txtnumber4.SetFocus
   
   txtnumber4.SelStart = 0
   txtnumber4.SelLength = Len(txtnumber1.Text)
   Exit Sub
    ElseIf txtnumber1.Text = txtnumber4.Text Or txtnumber4.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber2.Text Then
   MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"

Else
txtclass4.Enabled = True
 txtclass4.BackColor = &H80000005

 txtclass4.Text = Trim(adoRS("Class"))
  txtsp4.Enabled = True
 txtsp4.BackColor = &H80000005
  txtsex4.Enabled = True
 txtsex4.BackColor = &H80000005
 Command11.Enabled = True
 txtsp4.Text = Trim(adoRS("Speciality"))
 txtsex4.Text = adoRS("Sex")
 txtname4.Enabled = True
 txtname4.BackColor = &H80000005
  txtname4.Text = Trim(adoRS("Name"))
End If
  Set adoRS = Nothing

End Sub

Private Sub Command8_Click()
txtnumber1.Text = ""
txtname1.Text = ""
txtsex1.Text = ""
txtsp1.Text = ""
txtclass1.Text = ""
End Sub

Private Sub Command9_Click()
txtnumber2.Text = ""
txtname2.Text = ""
txtsex2.Text = ""
txtsp2.Text = ""
txtclass2.Text = ""

End Sub

Private Sub Form_Load()
Me.Height = 8625
Me.Width = 10380
Me.Move (Screen.Width - Me.Width) / 2 + 3000, (Screen.Height - Me.Height) / 2 - 800
 ShockwaveFlash1.Movie = App.Path & "\flash\top.swf"

 Dim sql As String
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 800
Frame1.Caption = Trim(frmsushe1.fk) & "宿舍资料"
fill
'学院
Set adoRS = adoCon.Execute("Select Name From College Order By Name")
cobcollege.Clear
Do While Not adoRS.EOF
  cobcollege.AddItem Trim(adoRS("Name"))
  adoRS.MoveNext
Loop
cobcollege.ListIndex = 0


End Sub
Private Sub fill()
txtnumber1.Text = ""
txtname1.Text = ""
txtnumber2.Text = ""
txtname2.Text = ""
txtnumber3.Text = ""
txtname3.Text = ""
txtnumber4.Text = ""
txtname4.Text = ""
txtsex1.Text = ""
txtsp1.Text = ""
txtclass1.Text = ""
txtsex2.Text = ""
txtsp2.Text = ""
txtclass2.Text = ""
txtsex3.Text = ""
txtsp3.Text = ""
txtclass3.Text = ""
txtsex4.Text = ""
txtsp4.Text = ""
txtclass4.Text = ""
txtname1.Enabled = False
txtname2.Enabled = False
txtname3.Enabled = False
txtname4.Enabled = False
txtsex1.Enabled = False
txtsex2.Enabled = False
txtsex3.Enabled = False
txtsex4.Enabled = False
txtsp1.Enabled = False
txtsp2.Enabled = False
txtsp3.Enabled = False
txtsp4.Enabled = False
txtclass1.Enabled = False
txtclass2.Enabled = False
txtclass3.Enabled = False
txtclass4.Enabled = False
txtname1.BackColor = &H80000013
txtname2.BackColor = &H80000013
txtname3.BackColor = &H80000013
txtname4.BackColor = &H80000013
txtsex1.BackColor = &H80000013
txtsex2.BackColor = &H80000013
txtsex3.BackColor = &H80000013
txtsex4.BackColor = &H80000013
txtsp1.BackColor = &H80000013
txtsp2.BackColor = &H80000013
txtsp3.BackColor = &H80000013
txtsp4.BackColor = &H80000013
txtclass1.BackColor = &H80000013
txtclass2.BackColor = &H80000013
txtclass3.BackColor = &H80000013
txtclass4.BackColor = &H80000013
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = False
Command11.Enabled = False


End Sub

Private Sub Option1_Click()
'学号
sql = "select * from Student  where Class='" & Trim(cobclass.Text) & "' order by ID "
Set adoRS = adoCon.Execute(sql)
List1.Clear
Do While adoRS.EOF
MsgBox "该班尚未录入学生！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
Loop
If cobclass.Text = "" Then
MsgBox "请选择班级！", vbOKOnly + vbExclamation, "系统提示"
End If
Do While Not adoRS.EOF
  List1.AddItem Trim(adoRS("ID"))
  adoRS.MoveNext
Loop

End Sub

Private Sub Option2_Click()
'姓名
sql = "select * from Student  where Class='" & Trim(cobclass.Text) & "' order by ID "
Set adoRS = adoCon.Execute(sql)
List1.Clear
Do While adoRS.EOF
MsgBox "该班尚未录入学生！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
Loop
If cobclass.Text = "" Then
MsgBox "请选择班级！", vbOKOnly + vbExclamation, "系统提示"
End If

Do While Not adoRS.EOF
  List1.AddItem Trim(adoRS("Name"))
  adoRS.MoveNext
Loop

End Sub