学生学籍成绩管理系统源程序.docx
《学生学籍成绩管理系统源程序.docx》由会员分享，可在线阅读，更多相关《学生学籍成绩管理系统源程序.docx（47页珍藏版）》请在冰豆网上搜索。
学生学籍成绩管理系统源程序
模块1:
OptionExplicit
PublicconAsADODB.Connection
PublicrsAsADODB.Recordset
PublicusernameAsString
PublicusergradeAsString
PublicuserpwdAsString
PubliccmdAsADODB.Command
模块2
OptionExplicit
Subhidewindow（）
WithActiveWindow
.DisplayGridlines=False
.DisplayHeadings=False
.DisplayOutline=False
.DisplayZeros=False
.DisplayHorizontalScrollBar=False
.DisplayVerticalScrollBar=False
.DisplayWorkbookTabs=False
EndWith
EndSub
Subshowwindow（）
WithActiveWindow
.DisplayGridlines=True
.DisplayHeadings=True
.DisplayOutline=True
.DisplayZeros=True
.DisplayHorizontalScrollBar=True
.DisplayVerticalScrollBar=True
EndWith
EndSub
模块3:
SubMacro1（）
Range（"D2:
D60000"）.Select
WithSelection.Validation
.Delete
.AddType:
=xlValidateList,AlertStyle:
=xlValidAlertStop,Operator:
=_
xlBetween,Formula1:
="团员,党员,预备党员,群众"
.IgnoreBlank=True
.InCellDropdown=True
.InputTitle=""
.ErrorTitle=""
.InputMessage=""
.ErrorMessage=""
.IMEMode=xlIMEModeNoControl
.ShowInput=True
.ShowError=True
EndWith
EndSub
SubMacro2（）
Range（"J2:
J60000"）.Select
WithSelection.Validation
.Delete
.AddType:
=xlValidateList,AlertStyle:
=xlValidAlertStop,Operator:
=_
xlBetween,Formula1:
="本科,专科"
.IgnoreBlank=True
.InCellDropdown=True
.InputTitle=""
.ErrorTitle=""
.InputMessage=""
.ErrorMessage=""
.IMEMode=xlIMEModeNoControl
.ShowInput=True
.ShowError=True
EndWith
EndSub
SubMacro3（）
Range（"K2:
K60000"）.Select
WithSelection.Validation
.Delete
.AddType:
=xlValidateList,AlertStyle:
=xlValidAlertStop,Operator:
=_
xlBetween,Formula1:
="在校,休学,毕业"
.IgnoreBlank=True
.InCellDropdown=True
.InputTitle=""
.ErrorTitle=""
.InputMessage=""
.ErrorMessage=""
.IMEMode=xlIMEModeNoControl
.ShowInput=True
.ShowError=True
EndWith
EndSub
UserForm1代码:
OptionExplicit
PrivateSubCommandButton1_Click（）
OnErrorGoTodoerror
DimsqlAsString
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
sql="select*from用户数据表where用户名='"&UserForm1.ComboBox1.Text&"'"
rs.Opensql,con,adOpenKeyset,adLockOptimistic
IfUserForm1.ComboBox1.Text=""Then
MsgBox"用户名不能为空！
"
UserForm1.ComboBox1.SetFocus
ExitSub
EndIf
IfUserForm1.TextBox2.Text=""Then
MsgBox"密码不能为空！
"
UserForm1.TextBox2.SetFocus
ExitSub
EndIf
IfTrim（rs.Fields（"密码"））=Trim（UserForm1.TextBox2.Text）Then
username=Trim（rs.Fields（"用户名"））
usergrade=Trim（rs.Fields（"权限"））
userpwd=Trim（rs.Fields（"密码"））
Workbooks.Application.Visible=True
Sheets（"目录"）.Activate
Me.Hide
UnloadMe
Else
MsgBox"密码错误"
TextBox2.Text=""
TextBox2.SetFocus
ExitSub
EndIf
rs.Close
con.Close
Setrs=Nothing
Setcon=Nothing
ExitSub
doerror:
MsgBox"系统出现错误"
EndSub
PrivateSubCommandButton2_Click（）
ActiveWorkbook.Save
Application.Quit
EndSub
PrivateSubUserForm_Initialize（）
DimiAsInteger
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
rs.Open"select*from用户数据表",con,adOpenKeyset,adLockOptimistic
Fori=1Tors.RecordCount
UserForm1.ComboBox1.AddItemrs.Fields（"用户名"）
rs.MoveNext
Nexti
rs.Close
con.Close
Setrs=Nothing
Setcon=Nothing
EndSub
UserForm2代码:
OptionExplicit
PrivateSubCommandButton1_Click（）
OnErrorResumeNext
Application.ScreenUpdating=False
DimsqlAsString
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
Setcmd=NewADODB.Command
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
Setcmd.ActiveConnection=con
IfUserForm2.TextBox1.Text=""OrUserForm2.TextBox2.Text=""OrUserForm2.TextBox3.Text=""Then
MsgBox"更改信息不齐全！
",48
ExitSub
EndIf
Ifuserpwd=Trim（UserForm2.TextBox1.Text）Then
IfTrim（UserForm2.TextBox2）=Trim（UserForm2.TextBox3）Then
cmd.CommandText="update用户数据表set密码='"&UserForm2.TextBox2.Text&"'where用户名='"&username&"'"
cmd.Execute
MsgBox"密码更换成功！
请牢记密码！
"
UnloadMe
Else
MsgBox"确认密码输入有误，请重新输入！
"
UserForm2.TextBox3.SetFocus
EndIf
Else
MsgBox"原密码输入错误，请重新输入！
"
UserForm2.TextBox1.SetFocus
EndIf
Application.ScreenUpdating=True
rs.Close
con.Close
Setrs=Nothing
Setcon=Nothing
EndSub
PrivateSubCommandButton2_Click（）
UnloadMe
EndSub
UserForm3代码:
OptionExplicit
PrivateSubCommandButton1_Click（）
OnErrorResumeNext
DimyAsInteger
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
Setcmd=NewADODB.Command
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
rs.Open"select*from用户数据表where用户名='"&UserForm3.TextBox1.Text&"'",con,adOpenKeyset,adLockOptimistic
IfUserForm3.TextBox1.Text=""OrUserForm3.TextBox2.Text=""OrUserForm3.TextBox1.Text=""Then
MsgBox"信息不全，请完整填写信息"
ExitSub
EndIf
IfNotrs.EOFThen
MsgBox"用户名已存在，请重新输入"
ExitSub
Else
Setcmd.ActiveConnection=con
cmd.CommandText="INSERTINTO用户数据表（用户名,密码,权限）VALUES（'"&Trim（UserForm3.TextBox1.Text）&"','"&Trim（UserForm3.TextBox2.Text）&"','"&Trim（UserForm3.ComboBox1.Text）&"'）"
cmd.Execute
y=MsgBox（"数据保存成功，是否继续增加",vbYesNo,"提示信息！
"）
Ify=vbYesThen
WithUserForm3
.TextBox1.Text=""
.TextBox2.Text=""
.ComboBox1.Text=""
.TextBox1.SetFocus
ExitSub
EndWith
ElseIfy=vbNoThen
UnloadMe
ExitSub
EndIf
EndIf
rs.Close
con.Close
Setrs=Nothing
Setcon=Nothing
EndSub
UserForm4代码:
OptionExplicit
PrivateSubCommandButton1_Click（）
OnErrorResumeNext
DimyAsString
DimcmdAsADODB.Command
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
Setcmd=NewADODB.Command
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
Setcmd.ActiveConnection=con
IfTrim（username）=Trim（UserForm4.ComboBox1.Text）Then
MsgBox"当前用户不能删除"
ExitSub
EndIf
y=MsgBox（"您是否真的删除该用户?
",vbYesNo+64,"提示"）
Ify=vbYesThen
cmd.CommandText="delete*from用户数据表where用户名='"&UserForm4.ComboBox1.Text&"'"
cmd.Execute
MsgBox"删除成功"
Me.Hide
UnloadMe
Else
UserForm4.ComboBox1.Text=""
ExitSub
EndIf
rs.Close
con.Close
Setrs=Nothing
Setcon=Nothing
EndSub
PrivateSubCommandButton2_Click（）
UnloadMe
EndSub
PrivateSubUserForm_Initialize（）
OnErrorResumeNext
DimiAsInteger
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
rs.Open"select*from用户数据表",con,adOpenKeyset,adLockOptimistic
Fori=1Tors.RecordCount
ComboBox1.AddItemrs.Fields（"用户名"）
rs.MoveNext
Nexti
rs.Close
con.Close
Setrs=Nothing
Setcon=Nothing
EndSub
PrivateSubCommandButton2_Click（）
UnloadMe
EndSub
PrivateSubUserForm_Initialize（）
OnErrorResumeNext
ComboBox1.AddItem（"一般用户"）
ComboBox1.AddItem（"高级用户"）
ComboBox1.AddItem（"管理员"）
EndSub
UserForm5代码:
OptionExplicit
PrivateSubCommandButton1_Click（）
OnErrorResumeNext
DimsqlAsString
DimconAsADODB.Connection
DimrsAsADODB.Recordset
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
IfUserForm5.TextBox1.Text=""Then
MsgBox"查询条件不能为空！
"
UserForm5.TextBox1.SetFocus
ExitSub
EndIf
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
sql="select*from学生数据表where学号='"&UserForm5.TextBox1.Text&"'"
rs.Opensql,con,adOpenKeyset,adLockOptimistic
IfNotrs.EOFThen
WithUserForm5
.Label24.Caption=rs.Fields（"学号"）
.Label19.Caption=rs.Fields（"姓名"）
.Label17.Caption=rs.Fields（"性别"）
.Label16.Caption=rs.Fields（"政治面貌"）
.Label20.Caption=rs.Fields（"入学时间"）
.Label21.Caption=rs.Fields（"出生年月"）
.Label27.Caption=rs.Fields（"班级代码"）
.Label18.Caption=rs.Fields（"专业代码"）
.Label26.Caption=rs.Fields（"民族"）
.Label25.Caption=rs.Fields（"层次"）
.Label23.Caption=rs.Fields（"在校状态"）
EndWith
Else
MsgBox"没有找到查询结果"
ExitSub
EndIf
UserForm5.CommandButton7.Enabled=True
UserForm5.CommandButton8.Enabled=True
UserForm5.CommandButton9.Enabled=True
EndSub
PrivateSubCommandButton6_Click（）
UnloadMe
EndSub
PrivateSubCommandButton7_Click（）
OnErrorResumeNext
DimyAsInteger
DimcmdAsADODB.Command
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
Setcmd=NewADODB.Command
Setcmd.ActiveConnection=con
IfTrim（UserForm5.Label23.Caption）=Trim（"在校"）Then
y=MsgBox（"您是否要进行休学处理",vbYesNo,"提示信息！
"）
Ify=vbYesThen
UserForm5.Label23.Caption="休学"
cmd.CommandText="update学生数据表set在校状态='"&UserForm5.Label23.Caption&"'where学号='"&UserForm5.Label24.Caption&"'"
cmd.Execute
MsgBox"更新成功"
Else
ExitSub
EndIf
Else
MsgBox"不能进行休学处理"
ExitSub
EndIf
UserForm5.CommandButton8.Enabled=False
UserForm5.CommandButton9.Enabled=False
EndSub
PrivateSubCommandButton8_Click（）
OnErrorResumeNext
DimyAsInteger
DimcmdAsADODB.Command
Setcon=NewADODB.Connection
Setrs=NewADODB.Recordset
con.Open"Provider=Microsoft.Jet.OLEDB.4.0;Datasource="&ThisWorkbook.Path&"\xjcj.mdb"
Setcmd=NewADODB.Command
Setcmd.ActiveConnection=con
IfTrim（UserForm5.Label23.Caption）=Trim（"休学"）Then
y=MsgBox（"您是否要进行复学处理",vbYesNo,"提示信息！
"）
Ify=vbYesThen
UserForm5.Label23.Caption="在校"
cmd.CommandText="update学生数据表set在校状态='"&UserForm5.Label23.Caption&"'where学号='"&UserForm5.Label24.Caption&"'"
cmd.Execute
MsgBox"更新成功"
Else
ExitSub
EndIf
Else
MsgBox"不能进行复学处理"
ExitSub
EndIf
UserForm5.CommandButton7.Enabled=False
U
升级会员 