学生学籍成绩管理系统源程序

1、模块1:Option ExplicitPublic con As ADODB.ConnectionPublic rs As ADODB.RecordsetPublic username As StringPublic usergrade As StringPublic userpwd As StringPublic cmd As ADODB.Command模块2Option ExplicitSub hidewindow() With ActiveWindow .DisplayGridlines = False .DisplayHeadings = False .DisplayOutline =

2、 False .DisplayZeros = False .DisplayHorizontalScrollBar = False .DisplayVerticalScrollBar = False .DisplayWorkbookTabs = False End WithEnd SubSub showwindow() With ActiveWindow .DisplayGridlines = True .DisplayHeadings = True .DisplayOutline = True .DisplayZeros = True .DisplayHorizontalScrollBar =

3、 True .DisplayVerticalScrollBar = True End WithEnd Sub模块3:Sub Macro1() Range(D2:D60000).Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=团员,党员,预备党员,群众 .IgnoreBlank = True .InCellDropdown = True .InputTitle = .ErrorTit

4、le = .InputMessage = .ErrorMessage = .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With End SubSub Macro2() Range(J2:J60000).Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=本科,专科 .IgnoreBlank

5、= True .InCellDropdown = True .InputTitle = .ErrorTitle = .InputMessage = .ErrorMessage = .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With End SubSub Macro3() Range(K2:K60000).Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,

6、Operator:= _ xlBetween, Formula1:=在校,休学,毕业 .IgnoreBlank = True .InCellDropdown = True .InputTitle = .ErrorTitle = .InputMessage = .ErrorMessage = .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With End SubUserForm1代码:Option ExplicitPrivate Sub CommandButton1_Click()On Error Go

7、To doerrorDim sql As StringSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbsql = select * from 用户数据表 where 用户名= & UserForm1.ComboBox1.Text & rs.Open sql, con, adOpenKeyset, adLockOptimisticIf UserForm1.Com

8、boBox1.Text = Then MsgBox 用户名不能为空！ UserForm1.ComboBox1.SetFocus Exit SubEnd IfIf UserForm1.TextBox2.Text = Then MsgBox 密码不能为空！ UserForm1.TextBox2.SetFocus Exit SubEnd IfIf Trim(rs.Fields(密码) = Trim(UserForm1.TextBox2.Text) Then username = Trim(rs.Fields(用户名) usergrade = Trim(rs.Fields(权限) userpwd =

9、Trim(rs.Fields(密码) Workbooks.Application.Visible = True Sheets(目录).Activate Me.Hide Unload MeElse MsgBox 密码错误 TextBox2.Text = TextBox2.SetFocusExit SubEnd Ifrs.Closecon.CloseSet rs = NothingSet con = NothingExit Subdoerror:MsgBox 系统出现错误End SubPrivate Sub CommandButton2_Click()ActiveWorkbook.SaveAppl

10、ication.QuitEnd SubPrivate Sub UserForm_Initialize()Dim i As IntegerSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbrs.Open select * from 用户数据表 , con, adOpenKeyset, adLockOptimisticFor i = 1 To rs.RecordCo

11、untUserForm1.ComboBox1.AddItem rs.Fields(用户名)rs.MoveNextNext irs.Closecon.CloseSet rs = NothingSet con = NothingEnd SubUserForm2代码:Option ExplicitPrivate Sub CommandButton1_Click()On Error Resume NextApplication.ScreenUpdating = FalseDim sql As StringSet con = New ADODB.ConnectionSet rs = New ADODB.

12、RecordsetSet cmd = New ADODB.Commandcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbSet cmd.ActiveConnection = conIf UserForm2.TextBox1.Text = Or UserForm2.TextBox2.Text = Or UserForm2.TextBox3.Text = Then MsgBox 更改信息不齐全！, 48 Exit Sub End IfIf userpwd = Trim(User

13、Form2.TextBox1.Text) Then If Trim(UserForm2.TextBox2) = Trim(UserForm2.TextBox3) Then cmd.CommandText = update 用户数据表 set 密码= & UserForm2.TextBox2.Text & where 用户名= & username & cmd.Execute MsgBox 密码更换成功！请牢记密码！ Unload Me Else MsgBox 确认密码输入有误，请重新输入！ UserForm2.TextBox3.SetFocus End IfElse MsgBox 原密码输入错

14、误，请重新输入！ UserForm2.TextBox1.SetFocus End If Application.ScreenUpdating = True rs.Closecon.CloseSet rs = NothingSet con = NothingEnd Sub Private Sub CommandButton2_Click()Unload MeEnd SubUserForm3代码:Option ExplicitPrivate Sub CommandButton1_Click()On Error Resume NextDim y As IntegerSet con = New ADO

15、DB.ConnectionSet rs = New ADODB.RecordsetSet cmd = New ADODB.Commandcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbrs.Open select * from 用户数据表 where 用户名= & UserForm3.TextBox1.Text & , con, adOpenKeyset, adLockOptimisticIf UserForm3.TextBox1.Text = Or UserForm3.T

16、extBox2.Text = Or UserForm3.TextBox1.Text = ThenMsgBox 信息不全，请完整填写信息Exit SubEnd IfIf Not rs.EOF ThenMsgBox 用户名已存在，请重新输入Exit SubElseSet cmd.ActiveConnection = concmd.CommandText = INSERT INTO 用户数据表 (用户名,密码,权限) VALUES ( & Trim(UserForm3.TextBox1.Text) & , & Trim(UserForm3.TextBox2.Text) & , & Trim(User

17、Form3.ComboBox1.Text) & )cmd.Executey = MsgBox(数据保存成功，是否继续增加, vbYesNo, 提示信息！) If y = vbYes Then With UserForm3 .TextBox1.Text = .TextBox2.Text = .ComboBox1.Text = .TextBox1.SetFocus Exit Sub End With ElseIf y = vbNo Then Unload Me Exit Sub End IfEnd Ifrs.Closecon.CloseSet rs = NothingSet con = Nothi

18、ngEnd SubUserForm4代码:Option ExplicitPrivate Sub CommandButton1_Click()On Error Resume NextDim y As StringDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.RecordsetSet cmd = New ADODB.Commandcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbS

19、et cmd.ActiveConnection = conIf Trim(username) = Trim(UserForm4.ComboBox1.Text) ThenMsgBox 当前用户不能删除Exit SubEnd Ify = MsgBox(您是否真的删除该用户?, vbYesNo + 64, 提示)If y = vbYes Thencmd.CommandText = delete * from 用户数据表 where 用户名= & UserForm4.ComboBox1.Text & cmd.ExecuteMsgBox 删除成功Me.HideUnload MeElseUserForm4

20、.ComboBox1.Text = Exit SubEnd Ifrs.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivate Sub CommandButton2_Click()Unload MeEnd SubPrivate Sub UserForm_Initialize()On Error Resume NextDim i As IntegerSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OL

21、EDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbrs.Open select * from 用户数据表 , con, adOpenKeyset, adLockOptimisticFor i = 1 To rs.RecordCountComboBox1.AddItem rs.Fields(用户名)rs.MoveNextNext irs.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivate Sub CommandButton2_Click()Unload MeEnd SubP

22、rivate Sub UserForm_Initialize()On Error Resume NextComboBox1.AddItem (一般用户)ComboBox1.AddItem (高级用户)ComboBox1.AddItem (管理员)End SubUserForm5代码:Option ExplicitPrivate Sub CommandButton1_Click()On Error Resume NextDim sql As StringDim con As ADODB.ConnectionDim rs As ADODB.RecordsetSet con = New ADODB.

23、ConnectionSet rs = New ADODB.RecordsetIf UserForm5.TextBox1.Text = Then MsgBox 查询条件不能为空！ UserForm5.TextBox1.SetFocus Exit SubEnd Ifcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbsql = select * from 学生数据表 where 学号= & UserForm5.TextBox1.Text & rs.Open sql, con, ad

24、OpenKeyset, adLockOptimisticIf Not rs.EOF ThenWith UserForm5.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

25、.Caption = rs.Fields(专业代码).Label26.Caption = rs.Fields(民族).Label25.Caption = rs.Fields(层次).Label23.Caption = rs.Fields(在校状态)End WithElseMsgBox 没有找到查询结果Exit SubEnd IfUserForm5.CommandButton7.Enabled = TrueUserForm5.CommandButton8.Enabled = TrueUserForm5.CommandButton9.Enabled = TrueEnd SubPrivate Sub

26、 CommandButton6_Click()Unload MeEnd SubPrivate Sub CommandButton7_Click()On Error Resume NextDim y As IntegerDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbSet cmd = New ADODB.Comm

27、andSet cmd.ActiveConnection = conIf Trim(UserForm5.Label23.Caption) = Trim(在校) Theny = MsgBox(您是否要进行休学处理, vbYesNo, 提示信息！)If y = vbYes ThenUserForm5.Label23.Caption = 休学 cmd.CommandText = update 学生数据表 set 在校状态= & UserForm5.Label23.Caption & where 学号= & UserForm5.Label24.Caption & cmd.ExecuteMsgBox 更新

28、成功Else Exit SubEnd IfElseMsgBox 不能进行休学处理Exit SubEnd IfUserForm5.CommandButton8.Enabled = FalseUserForm5.CommandButton9.Enabled = FalseEnd SubPrivate Sub CommandButton8_Click()On Error Resume NextDim y As IntegerDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Ope

29、n Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbSet cmd = New ADODB.CommandSet cmd.ActiveConnection = conIf Trim(UserForm5.Label23.Caption) = Trim(休学) Theny = MsgBox(您是否要进行复学处理, vbYesNo, 提示信息！)If y = vbYes ThenUserForm5.Label23.Caption = 在校 cmd.CommandText = update 学生数据

30、表 set 在校状态= & UserForm5.Label23.Caption & where 学号= & UserForm5.Label24.Caption & cmd.ExecuteMsgBox 更新成功Else Exit SubEnd IfElseMsgBox 不能进行复学处理Exit SubEnd IfUserForm5.CommandButton7.Enabled = FalseUserForm5.CommandButton9.Enabled = FalseEnd SubPrivate Sub CommandButton9_Click()On Error Resume NextDim

31、 y As IntegerDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbSet cmd = New ADODB.CommandSet cmd.ActiveConnection = conIf UserForm5.Label24.Caption = Or Trim(UserForm5.Label23.Captio

32、n) = Trim(毕业) ThenMsgBox 不能进行退学处理Exit SubEnd Ify = MsgBox(您是否要进行退学处理, vbYesNo, 提示信息！)If y = vbYes Thencmd.CommandText = delete from 学生数据表 where 学号= & UserForm5.Label24.Caption & cmd.Execute With UserForm5.TextBox1.Text = .Label24.Caption = .Label19.Caption = .Label17.Caption = .Label16.Caption = .La

33、bel20.Caption = .Label21.Caption = .Label27.Caption = .Label18.Caption = .Label26.Caption = .Label25.Caption = .Label23.Caption = End WithElse Exit SubEnd IfUserForm5.CommandButton7.Enabled = FalseUserForm5.CommandButton8.Enabled = Falsers.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivat

34、e Sub UserForm_Initialize()UserForm5.CommandButton7.Enabled = FalseUserForm5.CommandButton8.Enabled = FalseUserForm5.CommandButton9.Enabled = FalseEnd SubUserForm6代码:Option ExplicitPrivate Sub CommandButton1_Click()On Error Resume NextDim sql As StringDim cmd As ADODB.CommandSet cmd = New ADODB.Comm

35、andSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbIf UserForm6.TextBox4.Text = Or UserForm6.TextBox1.Text = Or UserForm6.TextBox5.Text = ThenMsgBox 信息不全Exit SubEnd Ifsql = select * from 成绩数据表 where 学号 = &

36、 UserForm6.TextBox4.Text & and 课程名= & UserForm6.TextBox1.Text & and 开设学期= & UserForm6.TextBox5.Text & rs.Open sql, con, 1, 3If Not rs.EOF ThenUserForm6.TextBox2.Text = rs.Fields(分数)UserForm6.TextBox3.Text = rs.Fields(补考分数)ElseMsgBox 没有搜索到信息Exit SubEnd IfUserForm6.CommandButton2.Enabled = TrueUserFor

37、m6.CommandButton6.Enabled = Truers.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivate Sub CommandButton2_Click()On Error Resume NextDim sql As StringDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.RecordsetSet cmd = New ADODB.Commandcon.Open Provider=Microsoft.Jet

38、.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbSet cmd.ActiveConnection = conIf UserForm6.TextBox4.Text = Or UserForm6.TextBox1.Text = Or UserForm6.TextBox5.Text = ThenMsgBox 信息不全Exit SubEnd Ifcmd.CommandText = delete from 成绩数据表 where 学号 = & UserForm6.TextBox4.Text & and 课程名= & UserForm6.Text

39、Box1.Text & and 开设学期= & UserForm6.TextBox5.Text & cmd.ExecuteIf UserForm6.TextBox2.Text 60 ThenUserForm6.TextBox3.Text = 0End Ifcmd.CommandText = insert into 成绩数据表 (课程名,学号,开设学期,分数,补考分数) values ( & UserForm6.TextBox1.Text & , & UserForm6.TextBox4.Text & , & UserForm6.TextBox5.Text & , & UserForm6.Tex

40、tBox2.Text & , & UserForm6.TextBox3.Text & )cmd.ExecuteMsgBox 提交成功rs.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivate Sub CommandButton4_Click()Unload MeEnd SubPrivate Sub CommandButton6_Click()On Error Resume NextDim y As IntegerDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet

41、 rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbIf UserForm6.TextBox4.Text = Or UserForm6.TextBox1.Text = Or UserForm6.TextBox5.Text = ThenMsgBox 信息不全，不能删除Exit SubEnd IfSet cmd = New ADODB.Commandy = MsgBox(您是否要进行删除处理, vbYesNo, 提示信息！)If y

42、 = vbYes ThenSet cmd.ActiveConnection = concmd.CommandText = delete from 成绩数据表 where 学号 = & UserForm6.TextBox4.Text & and 课程名= & UserForm6.TextBox1.Text & and 开设学期= & UserForm6.TextBox5.Text & cmd.ExecuteMsgBox 删除成功Else Exit SubEnd Ifrs.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivate S

43、ub UserForm_Initialize()UserForm6.CommandButton2.Enabled = FalseUserForm6.CommandButton6.Enabled = FalseEnd SubUserForm7代码:Option ExplicitPrivate Sub CommandButton1_Click()Dim sql As StringDim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.RecordsetSet cmd = New ADODB.CommandIf

44、 UserForm7.TextBox1.Text = Or UserForm7.TextBox2.Text = Or UserForm7.ComboBox2.Text = Or UserForm7.TextBox4.Text = Or UserForm7.ComboBox1.Text = ThenMsgBox 信息不全Exit SubEnd Ifcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path & xjcj.mdbsql = select * from 课程数据表 where 课程号= & Us

45、erForm7.TextBox1.Text & rs.Open sql, con, adOpenKeyset, adLockOptimisticIf Not rs.EOF ThenMsgBox 课程号存在Exit SubElseSet cmd.ActiveConnection = concmd.CommandText = insert into 课程数据表 (课程号,课程名,课程性质,学分,开设学期) values ( & UserForm7.TextBox1.Text & , & UserForm7.TextBox2.Text & , & UserForm7.ComboBox2.Text &

46、 , & UserForm7.TextBox4.Text & , & UserForm7.ComboBox1.Text & )cmd.ExecuteMsgBox 数据提交成功End IfEnd SubPrivate Sub CommandButton2_Click()Dim cmd As ADODB.CommandSet con = New ADODB.ConnectionSet rs = New ADODB.RecordsetSet cmd = New ADODB.Commandcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= &

47、ThisWorkbook.Path & xjcj.mdbIf UserForm7.TextBox1.Text = Or UserForm7.TextBox2.Text = Or UserForm7.ComboBox2.Text = Or UserForm7.TextBox4.Text = Or UserForm7.ComboBox1.Text = ThenMsgBox 信息不全Exit SubEnd IfSet cmd.ActiveConnection = concmd.CommandText = delete from 课程数据表 where 课程号= & UserForm7.TextBox

48、1.Text & cmd.Executecmd.CommandText = insert into 课程数据表 (课程号,课程名,课程性质,学分,开设学期) values ( & UserForm7.TextBox1.Text & , & UserForm7.TextBox2.Text & , & UserForm7.ComboBox2.Text & , & UserForm7.TextBox4.Text & , & UserForm7.ComboBox1.Text & )cmd.ExecuteMsgBox 提交成功UserForm7.CommandButton1.Enabled = True

49、UserForm7.CommandButton2.Enabled = FalseEnd SubPrivate Sub CommandButton4_Click()Unload MeEnd SubPrivate Sub CommandButton5_Click()On Error Resume NextDim sql As StringSet con = New ADODB.ConnectionSet rs = New ADODB.Recordsetcon.Open Provider=Microsoft.Jet.OLEDB.4.0;Data source= & ThisWorkbook.Path

50、 & xjcj.mdbIf UserForm7.TextBox5.Text = ThenMsgBox 请输入查询信息Exit SubEnd Ifsql = select * from 课程数据表 where 课程号= & UserForm7.TextBox5.Text & rs.Open sql, con, adOpenKeyset, adLockOptimisticIf Not rs.EOF ThenWith UserForm7.TextBox1.Text = rs.Fields(课程号).Value.TextBox2.Text = rs.Fields(课程名).Value.ComboBox

51、2.Text = rs.Fields(课程性质).Value.TextBox4.Text = rs.Fields(学分).Value.ComboBox1.Text = rs.Fields(开设学期).ValueEnd WithElseMsgBox 输入的课程名不存在，请重新输入Exit SubEnd IfUserForm7.Label7.Visible = TrueUserForm7.CommandButton2.Enabled = TrueUserForm7.CommandButton1.Enabled = Falsers.Closecon.CloseSet rs = NothingSet con = NothingEnd SubPrivate Sub UserForm_Initialize()On Error Resume NextDim i As IntegerUserForm7.ComboBox1.ClearFor i = 1 To 8UserForm7.ComboBox1.AddItem iNext iWith