frmliveupdate2.frm

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

End Select
End Sub

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

Private Sub Command3_Click()
Unload Me

End Sub

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

txtnumber2.Text = ""
txtname2.Text = ""
txtsex2.Text = ""
txtsp2.Text = ""
txtclass2.Text = ""

txtnumber3.Text = ""
txtname3.Text = ""
txtsex3.Text = ""
txtsp3.Text = ""
txtclass3.Text = ""

txtnumber4.Text = ""
txtname4.Text = ""
txtsex4.Text = ""
txtsp4.Text = ""
txtclass4.Text = ""
End Sub
Private Sub fillRecord1()
'添加对应控件
 
 Dim sql As String
If frmliveupdate.Option1.Value = True Then
  sql = "select * from Room where 学号='" & frmliveupdate.fup & "'"
End If

If frmliveupdate.Option2.Value = True Then
  sql = "select * from Room where 姓名='" & frmliveupdate.fup & "'"

End If

If frmliveupdate.Option1.Value = False And frmliveupdate.Option2.Value = False Then
  sql = "select * from Room where 宿舍='" & frmliveupdate.fup & "'"
End If
 Set adoRS = adoCon.Execute(sql)
  sushe = adoRS("宿舍")

sql = ""
sql = "select * from Room where 宿舍='" & sushe & "'"
'床位1
 Set adoRS = adoCon.Execute(sql)
 If adoRS.EOF = False Then
txtnumber1.Text = IIf(IsNull(adoRS("学号")), "", adoRS("学号"))
a1 = txtnumber1.Text
txtname1.Text = IIf(IsNull(adoRS("姓名")), "", adoRS("姓名"))
txtsp1.Text = IIf(IsNull(adoRS("专业")), "", adoRS("专业"))
txtclass1.Text = IIf(IsNull(adoRS("班别")), "", adoRS("班别"))
txtsex1.Text = IIf(IsNull(adoRS("性别")), "", adoRS("性别"))
Else
txtnumber1.Text = ""
txtname1.Text = ""
txtsp1.Text = ""
txtclass1.Text = ""
txtsex1.Text = ""

End If
adoRS.MoveNext

 Set adoRS = Nothing
 
 
 '床位2
 sql = ""
 sql = "select * from Room where 宿舍='" & sushe & "' and not 学号  = '" & Trim(txtnumber1.Text) & "'"
Set adoRS = adoCon.Execute(sql)
If adoRS.EOF = False Then
txtnumber2.Text = IIf(IsNull(adoRS("学号")), "", adoRS("学号"))
a2 = txtnumber2.Text
txtname2.Text = IIf(IsNull(adoRS("姓名")), "", adoRS("姓名"))
txtsp2.Text = IIf(IsNull(adoRS("专业")), "", adoRS("专业"))
txtclass2.Text = IIf(IsNull(adoRS("班别")), "", adoRS("班别"))
txtsex2.Text = IIf(IsNull(adoRS("性别")), "", adoRS("性别"))

Else
txtnumber2.Text = ""
txtname2.Text = ""
txtsp2.Text = ""
txtclass2.Text = ""
txtsex2.Text = ""

End If

 Set adoRS = Nothing

 '床位3
 sql = ""
 sql = "select * from Room where 宿舍='" & sushe & "'and not 学号  = '" & txtnumber1.Text & "' and not 学号  = '" & txtnumber2.Text & "'"
 Set adoRS = adoCon.Execute(sql)
If adoRS.EOF = False Then
txtnumber3.Text = IIf(IsNull(adoRS("学号")), "", adoRS("学号"))

a3 = txtnumber3.Text
txtname3.Text = IIf(IsNull(adoRS("姓名")), "", adoRS("姓名"))
txtsp3.Text = IIf(IsNull(adoRS("专业")), "", adoRS("专业"))
txtclass3.Text = IIf(IsNull(adoRS("班别")), "", adoRS("班别"))
txtsex3.Text = IIf(IsNull(adoRS("性别")), "", adoRS("性别"))
Else
txtnumber3.Text = ""
txtname3.Text = ""
txtsp3.Text = ""
txtclass3.Text = ""
txtsex3.Text = ""

End If


Set adoRS = Nothing
'床位4
 sql = ""
 sql = "select * from Room where 宿舍='" & sushe & "'and not 学号  = '" & txtnumber1.Text & "' and not 学号  = '" & txtnumber2.Text & "' and not 学号  = '" & txtnumber3.Text & "'"
 Set adoRS = adoCon.Execute(sql)
If adoRS.EOF = False Then
txtnumber4.Text = IIf(IsNull(adoRS("学号")), "", adoRS("学号"))
a4 = txtnumber4.Text
txtname4.Text = IIf(IsNull(adoRS("姓名")), "", adoRS("姓名"))
txtsp4.Text = IIf(IsNull(adoRS("专业")), "", adoRS("专业"))
txtclass4.Text = IIf(IsNull(adoRS("班别")), "", adoRS("班别"))
txtsex4.Text = IIf(IsNull(adoRS("性别")), "", adoRS("性别"))
Else
txtnumber4.Text = ""
txtname4.Text = ""
txtsp4.Text = ""
txtclass4.Text = ""
txtsex4.Text = ""

End If


 Set adoRS = Nothing
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 = adoRS("Class")
  txtsp3.Enabled = True
 txtsp3.BackColor = &H80000005
 txtsp3.Text = adoRS("Speciality")
  txtsex3.Enabled = True
 txtsex3.BackColor = &H80000005

 txtsex3.Text = adoRS("Sex")
  txtname3.Enabled = True
 txtname3.BackColor = &H80000005
Command10.Enabled = True
  txtname3.Text = 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 = adoRS("Class")
 txtsp1.Enabled = True
 txtsp1.BackColor = &H80000005
 txtsp1.Text = adoRS("Speciality")
 txtsp1.BackColor = &H80000005
 txtsex1.Enabled = True
 txtsex1.BackColor = &H80000005
 txtsex1.Text = adoRS("Sex")
 txtname1.Enabled = True
 txtname1.BackColor = &H80000005
 txtname1.Text = 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 = adoRS("Class")
  txtsp2.Enabled = True
 txtsp2.BackColor = &H80000005
 txtsp2.Text = adoRS("Speciality")
 txtsex2.Enabled = True
 txtsex2.BackColor = &H80000005
 txtsex2.Text = adoRS("Sex")
 txtname2.Enabled = True
 txtname2.BackColor = &H80000005
  txtname2.Text = 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 = adoRS("Class")
  txtsp4.Enabled = True
 txtsp4.BackColor = &H80000005
  txtsex4.Enabled = True
 txtsex4.BackColor = &H80000005
 Command11.Enabled = True
 txtsp4.Text = adoRS("Speciality")
 txtsex4.Text = adoRS("Sex")
 txtname4.Enabled = True
 txtname4.BackColor = &H80000005
  txtname4.Text = adoRS("Name")
End If
  Set adoRS = Nothing

End Sub

Private Sub Command8_Click()
'修改床位1
sql = ""
sql = "delete Room where 学号='" & Trim(txtnumber1.Text) & "'"
adoCon.Execute (sql)

txtnumber1.Text = ""
txtname1.Text = ""
txtsex1.Text = ""
txtsp1.Text = ""
txtclass1.Text = ""
txtname1.BackColor = &H80000013
txtsex1.BackColor = &H80000013
txtsp1.BackColor = &H80000013
txtclass1.BackColor = &H80000013
txtname1.Enabled = False
txtsex1.Enabled = False
txtsp1.Enabled = False
txtclass1.Enabled = False

End Sub

Private Sub Command9_Click()
'修改床位2
sql = ""
sql = "delete Room where 学号='" & Trim(txtnumber2.Text) & "'"
adoCon.Execute (sql)

txtnumber2.Text = ""
txtname2.Text = ""
txtsex2.Text = ""
txtsp2.Text = ""
txtclass2.Text = ""
txtname2.BackColor = &H80000013
txtsex2.BackColor = &H80000013
txtsp2.BackColor = &H80000013
txtclass2.BackColor = &H80000013
txtname2.Enabled = False
txtsex2.Enabled = False
txtsp2.Enabled = False
txtclass2.Enabled = False


End Sub

Private Sub Form_Load()
ShockwaveFlash1.Movie = App.Path & "\flash\top.swf"
Me.Height = 8355
Me.Width = 10320
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 800
FillControl1
fillRecord1
'学院
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 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 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 adoRS("Name")
  adoRS.MoveNext
Loop

End Sub