资源目录
压缩包内文档预览：(预览前20页/共75页)
编号：58926343
类型：共享资源
大小：1.04MB
格式：RAR
上传时间：2020-03-17
上传人：qq77****057
认证信息
个人认证
李**（实名认证）
江苏
IP属地：江苏
7.2
积分
- 关 键 词：
-
学生
注册
管理软件
开发
- 资源描述：
-
学生注册管理软件的开发,学生,注册,管理软件,开发
- 内容简介：
-
目 录1标准模块程序设计代码22用户登陆界面程序代码33系统主界面程序代码64用户注册管理界面程序代码85班级信息管理界面程序代码146学生注册管理界面以及程序代码217课程注册管理界面及程序代码388成绩管理界面及程序代码449奖罚管理界面及程序代码6310个人信息查询界面以程序代码6911背景部分程序代码741 标准模块程序设计代码Public UserName As StringSub Main() Dim fLogin As New frmLogin fLogin.Show vbModal If Not fLogin.OK Then End End If Unload fLogin Set fMainForm = New frmMain fMainForm.ShowEnd SubPublic Function ConnectString() As String Dim strAppPath As String strAppPath = App.Path If Right(strAppPath, 1) Then strAppPath = strAppPath & End If strAppPath = strAppPath & DataStatus.mdb ConnectString = DRIVER=Microsoft Access Driver (*.mdb);DBQ= & strAppPath & :pwq=MQ2004End FunctionPublic Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim sTokens() As String On Error GoTo ExecuteSQL_Error sTokens = Split(SQL) Set cnn = New ADODB.Connection cnn.Open ConnectString If InStr(INSERT,DELETE,UPDATE, UCase$(sTokens(0) Then cnn.Execute SQL MsgString = sTokens(0) & query successful Else Set rst = New ADODB.Recordset rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic Set ExecuteSQL = rst MsgString = 查询到 & rst.RecordCount & 条记录 End IfExecuteSQL_Exit: Set rst = Nothing Set cnn = Nothing Exit FunctionExecuteSQL_Error: MsgString = 查询错误: & Err.Description Resume ExecuteSQL_ExitEnd FunctionPublic Sub EnterToTab(Keyasc As Integer) If Keyasc = 13 Then SendKeys TAB End IfEnd Sub2用户登陆界面程序代码图1Option ExplicitPrivate Declare Function GetUserName Lib advapi32.dll Alias GetUserNameA (ByVal lpbuffer As String, nSize As Long) As LongPublic OK As BooleanDim txtSQL As StringDim mrc As ADODB.RecordsetDim MsgText As StringDim miCount As IntegerPrivate Sub Form_Load() Dim i As Integer i = 0 txtSQL = select * from user_Form Set mrc = ExecuteSQL(txtSQL, MsgText) With txtUserName Do While Not mrc.EOF i = i + 1 .AddItem Trim(mrc!user_ID) mrc.MoveNext Loop .ListIndex = i - 1 End With mrc.Close OK = False miCount = 0End SubPrivate Sub cmdCancel_Click() OK = False Me.HideEnd SubPrivate Sub cmdOK_Click() txtSQL = select * from user_Form where user_ID = & txtUserName.Text & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = True Then MsgBox 没有这个用户，请重新输入用户名!, vbOKOnly + vbExclamation, 警告 txtUserName.SetFocus Else If Trim(mrc.Fields(1) = Trim(txtPassword.Text) Then OK = True mrc.Close Me.Hide UserName = Trim(txtUserName.Text) Else MsgBox 输入密码不正确，请重新输入！, vbOKOnly + vbExclamation, 警告 txtPassword.SetFocus txtPassword.Text = End If End If miCount = miCount + 1 If miCount = 3 Then Me.Hide End If Exit SubEnd SubPrivate Sub Label1_Click()End SubPrivate Sub txtPassword_KeyDown(KeyCode As Integer, Shift As Integer) EnterToTab KeyCodeEnd SubPrivate Sub txtPassword_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdOK_Click End IfEnd SubPrivate Sub txtUserName_Click() txtPassword.Text = End SubPrivate Sub txtUserName_KeyDown(KeyCode As Integer, Shift As Integer) EnterToTab KeyCodeEnd Sub3系统主界面程序代码图2Private Sub claiMenu_Click() frmclai.ShowEnd SubPrivate Sub couiMenu_Click() frmcoui.ShowEnd SubPrivate Sub cusiMenu_Click() frmcusi.ShowEnd SubPrivate Sub MDIForm_Load() dColor.ShowEnd SubPrivate Sub MDIForm_Resize() If Me.Height 1100 Then dColor.Height = Me.Height - 1100 End If If Me.Width 180 Then dColor.Width = Me.Width - 180 End IfEnd SubPrivate Sub prpiMenu_Click() frmprpi.ShowEnd SubPrivate Sub scoiMenu_Click() frmscoi.ShowEnd SubPrivate Sub stsiMenu_Click() frmstsi.ShowEnd SubPrivate Sub sumiMenu_Click() frmsumi.ShowEnd Sub4用户注册管理界面程序代码图3Dim mrc As ADODB.RecordsetDim MsgText As StringPrivate Sub Command1_Click() Dim txtSQL As String If Text1(0) = Then MsgBox 用户名称不能为空!, vbOKOnly, 提示 Text1(0).SetFocus Exit Sub End If If Text1(1) = Then MsgBox 用户密码不能为空!, vbOKOnly, 提示 Text1(1).SetFocus Exit Sub Else If Text1(1) Text1(2) Then MsgBox 两次密码输入不同!, vbOKOnly, 提示 Text1(1) = Text1(2) = Text1(1).SetFocus Exit Sub End If End If txtSQL = select * from user_Form where user_ID= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 此用户名已经存在!, vbOKOnly, 警告 Text1(0).SetFocus Exit Sub End If mrc.Close txtSQL = select * from user_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Fields(2) = Now mrc.Update mrc.Close For i = 0 To 2 Text1(i) = Next MsgBox 用户信息添加成功!, vbOKOnly, 提示 ListappEnd SubPrivate Sub Command2_Click() Text1(0) = Text1(1) = Text1(2) = End SubPrivate Sub Command3_Click() Dim txtSQL As String If Text1(3) = Then MsgBox 请你选择用户名称!, vbOKOnly, 提示 List1.SetFocus Exit Sub End If If Text1(4) = Then MsgBox 修改密码要旧密码!, vbOKOnly, 警告 Text1(4).SetFocus Exit Sub End If If Text1(5) = Then MsgBox 新的密码不能为空!, vbOKOnly, 提示 Text1(5).SetFocus Exit Sub Else If Text1(5) Text1(6) Then MsgBox 两次密码输入不同!, vbOKOnly, 提示 Text1(5) = Text1(6) = Text1(5).SetFocus Exit Sub End If End If txtSQL = select * from user_Form where user_ID= & Trim(Text1(3) & and user_PWD= & Trim(Text1(4) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then txtSQL = delete from user_Form where user_ID= & Trim(Text1(3) & Else MsgBox 用户密码输入错误!, vbOKOnly, 警告 Text1(4).SetFocus Exit Sub End If Set mrc = ExecuteSQL(txtSQL, MsgText) txtSQL = select * from user_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(3) mrc.Fields(1) = Trim(Text1(5) mrc.Fields(2) = Now mrc.Update mrc.Close For i = 3 To 6 Text1(i) = Next MsgBox 用户信息修改成功!, vbOKOnly, 提示End SubPrivate Sub Command4_Click() Text1(3) = Text1(4) = Text1(5) = Text1(6) = End SubPrivate Sub Command5_Click() Dim txtSQL As String If Text1(7) = Then MsgBox 请你选择用户名称!, vbOKOnly, 提示 List1.SetFocus Exit Sub Else If Text1(7) = UserName Then MsgBox 不可以删除正在使用的用户!, vbOKOnly, 警告 Text1(7) = Text1(8) = List1.SetFocus Exit Sub End If End If If Text1(8) = Then MsgBox 删除用户需要密码!, vbOKOnly, 警告 Text1(8).SetFocus Exit Sub End If txtSQL = select * from user_Form where user_ID= & Trim(Text1(7) & and user_PWD= & Trim(Text1(8) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then txtSQL = delete from user_Form where user_ID= & Trim(Text1(7) & Else MsgBox 用户密码输入错误!, vbOKOnly, 警告 Text1(8).SetFocus Exit Sub End If Set mrc = ExecuteSQL(txtSQL, MsgText) Text1(7) = Text1(8) = MsgBox 用户信息已经删除!, vbOKOnly, 提示 ListappEnd SubPrivate Sub Command6_Click() Text1(7) = Text1(8) = End SubPrivate Sub Form_Load() Me.Caption = 用户信息-添 加 Picture1(1).Top = Picture1(0).Top Picture1(1).Left = Picture1(0).Left Picture1(2).Top = Picture1(0).Top Picture1(2).Left = Picture1(0).Left Listapp For i = 0 To 2 Label2(i).BackColor = &HE0E0E0 Picture1(i).Visible = False Next Label2(0).BackColor = &HFFFFFF Picture1(0).Visible = TrueEnd SubPrivate Sub Label1_Click()End SubPrivate Sub Label2_Click(Index As Integer) Me.Caption = 用户信息 Me.Caption = Me.Caption & - & Trim(Label2(Index).Caption) For i = 0 To 2 Label2(i).BackColor = &HE0E0E0 Picture1(i).Visible = False Next Label2(Index).BackColor = &HFFFFFF Picture1(Index).Visible = True For i = 0 To 8 Text1(i) = NextEnd SubPrivate Sub Form_Resize() dColor.ZOrder 1End SubPrivate Sub Listapp() Dim txSQL As String Dim mrcc As ADODB.Recordset txSQL = select * from user_Form Set mrcc = ExecuteSQL(txSQL, MsgText) List1.Clear Do While Not mrcc.EOF List1.AddItem Trim(mrcc!user_ID) mrcc.MoveNext Loop mrcc.CloseEnd SubPrivate Sub List1_Click() If Picture1(1).Visible = True Then Text1(3) = List1.Text End If If Picture1(2).Visible = True Then Text1(7) = List1.Text End IfEnd SubPrivate Sub List1_KeyDown(KeyCode As Integer, Shift As Integer) EnterToTab KeyCodeEnd SubPrivate Sub Text1_GotFocus(Index As Integer) Text1(Index).SelStart = 0 Text1(Index).SelLength = Len(Text1(Index)End Sub5班级信息管理界面程序代码图4Dim mrc As ADODB.RecordsetDim MsgText As StringDim tSQL As StringPrivate Sub Command1_Click() If Text1(0) = Then MsgBox 班级编号不能为空!, vbOKOnly, 提示 Text1(0).SetFocus Exit Sub End If If Text1(1) = Then MsgBox 班级名称不能为空!, vbOKOnly, 提示 Text1(1).SetFocus Exit Sub End If If Text1(2) = Then MsgBox 导员姓名不能为空!, vbOKOnly, 提示 Text1(2).SetFocus Exit Sub End If txtSQL = select * from class_Form where class_NO= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 此班级编号已存在!, vbOKOnly, 警告 Text1(0).SetFocus Exit Sub End If mrc.Close txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Fields(2) = Trim(Text1(2) mrc.Fields(3) = Trim(Text1(3) mrc.Update mrc.Close For i = 0 To 3 Text1(i) = Next MsgBox 班级信息添加成功!, vbOKOnly, 提示 ShowDataEnd SubPrivate Sub Command2_Click() For i = 0 To 3 Text1(i) = NextEnd SubPrivate Sub Command3_Click() If Text1(5) = Then MsgBox 班级名称不能为空!, vbOKOnly, 提示 Text1(5).SetFocus Exit Sub End If If Text1(6) = Then MsgBox 导员姓名不能为空!, vbOKOnly, 提示 Text1(6).SetFocus Exit Sub End If txtSQL = delete from class_Form where class_NO= & Trim(Text1(4) & Set mrc = ExecuteSQL(txtSQL, MsgText) txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(4) mrc.Fields(1) = Trim(Text1(5) mrc.Fields(2) = Trim(Text1(6) mrc.Fields(3) = Trim(Text1(7) mrc.Update mrc.Close For i = 4 To 7 Text1(i) = Next MsgBox 班级信息修改成功!, vbOKOnly, 提示 ShowDataEnd SubPrivate Sub Command4_Click() For i = 4 To 7 Text1(i) = NextEnd SubPrivate Sub Command5_Click() txtSQL = delete from class_Form where class_NO= & Trim(Text1(8) & Set mrc = ExecuteSQL(txtSQL, MsgText) For i = 8 To 11 Text1(i) = Next MsgBox 班级信息以经删除!, vbOKOnly, 警告 ShowDataEnd SubPrivate Sub Command6_Click() For i = 8 To 11 Text1(i) = NextEnd SubPrivate Sub Form_Load() Me.Caption = 班级信息-添 加 Picture1(1).Top = Picture1(0).Top Picture1(1).Left = Picture1(0).Left Picture1(2).Top = Picture1(0).Top Picture1(2).Left = Picture1(0).Left ShowData For i = 0 To 2 Label2(i).BackColor = &HE0E0E0 Picture1(i).Visible = False Next Label2(0).BackColor = &HFFFFFF Picture1(0).Visible = TrueEnd SubPrivate Sub Form_Resize() dColor.ZOrder 1End SubPrivate Sub Label2_Click(Index As Integer) Me.Caption = 班级信息 Me.Caption = Me.Caption & - & Trim(Label2(Index).Caption) For i = 0 To 2 Label2(i).BackColor = &HE0E0E0 Picture1(i).Visible = False Next Label2(Index).BackColor = &HFFFFFF Picture1(Index).Visible = True For i = 0 To 11 Text1(i) = Next Command3.Enabled = False Command5.Enabled = FalseEnd SubPrivate Sub ShowData() Dim txSQL As String Dim mrcc As ADODB.Recordset txSQL = select * from class_Form Set mrcc = ExecuteSQL(txSQL, MsgText) With MSFlexGrid1 .ColWidth(0) = 1200 .ColWidth(1) = 1200 .ColWidth(2) = 1200 .ColWidth(3) = 6000 .TextMatrix(0, 0) = 班级编号 .TextMatrix(0, 1) = 班级名称 .TextMatrix(0, 2) = 导员姓名 .TextMatrix(0, 3) = 备注信息 .Rows = 1 Do While Not mrcc.EOF .Rows = .Rows + 1 For i = 0 To mrcc.Fields.Count - 1 .TextMatrix(.Rows - 1, i) = mrcc.Fields(i) & Next i mrcc.MoveNext Loop End With mrcc.CloseEnd SubPrivate Sub MSFlexGrid1_Click() If Picture1(1).Visible = True Then Text1(4) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0) Text1(5) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 1) Text1(6) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 2) Text1(7) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) Command3.Enabled = True End If If Picture1(2).Visible = True Then Text1(8) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0) Text1(9) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 1) Text1(10) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 2) Text1(11) = Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) Command5.Enabled = True End IfEnd SubPrivate Sub Text1_Change(Index As Integer) If Index = 4 Then tSQL = select * from class_Form where class_NO= & Trim(Text1(Index) & Set mrc = ExecuteSQL(tSQL, MsgText) If mrc.EOF = False Then Text1(5) = mrc.Fields(1) Text1(6) = mrc.Fields(2) Text1(7) = mrc.Fields(3) Command3.Enabled = True Exit Sub Else Text1(5) = Text1(6) = Text1(7) = Command3.Enabled = False End If mrc.Close End If If Index = 8 Then tSQL = select * from class_Form where class_NO= & Trim(Text1(Index) & Set mrc = ExecuteSQL(tSQL, MsgText) If mrc.EOF = False Then Text1(9) = mrc.Fields(1) Text1(10) = mrc.Fields(2) Text1(11) = mrc.Fields(3) Command5.Enabled = True Exit Sub Else Text1(9) = Text1(10) = Text1(11) = Command5.Enabled = False End If mrc.Close End IfEnd SubPrivate Sub Text1_GotFocus(Index As Integer) Text1(Index).SelStart = 0 Text1(Index).SelLength = Len(Text1(Index)End SubPrivate Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) EnterToTab KeyCodeEnd Sub6学生注册管理界面以及程序代码图5Dim mrc As ADODB.RecordsetDim MsgText As StringDim tSQL As StringPrivate Sub Combo1_Click() Text1(4) = Combo1.Text If Label1(3).BackColor &HFFFFFF Then If Label2(4).Caption = Combo1.Text Then Combo1.BackColor = &HE0E0E0 Else Combo1.BackColor = &HFFFFFF End If End IfEnd SubPrivate Sub Command1_Click() Dim txtSQL As String For i = 0 To 7 If i 4 Then If Text1(i) = Label2(i).Caption Then MsgBox 请 & Label2(i).Caption & !, vbOKOnly, 提示 Text1(i).SetFocus Exit Sub End If Else If Text1(i) = Label2(i).Caption Then MsgBox 请 & Label2(i).Caption & !, vbOKOnly, 提示 Combo1.SetFocus Exit Sub End If End If Next If IsDate(Text1(3) = False Then MsgBox 出生日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text1(3).SetFocus Exit Sub End If If IsDate(Text1(6) = False Then MsgBox 入学日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text1(6).SetFocus Exit Sub End If txtSQL = select * from student_Form where student_NO= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 学号不能重复!, vbOKOnly, 警告 Text1(0).SetFocus Exit Sub End If mrc.Close txtSQL = select * from student_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Fields(2) = Trim(Text1(2) mrc.Fields(3) = Trim(Text1(3) mrc.Fields(4) = Trim(Text1(4) mrc.Fields(5) = Trim(Text1(5) mrc.Fields(6) = Trim(Text1(6) mrc.Fields(7) = Trim(Text1(7) If Text1(8) = Label2(8).Caption Then mrc.Fields(8) = Else mrc.Fields(8) = Trim(Text1(8) End If mrc.Update mrc.Close MsgBox 学籍信息添加成功!, vbOKOnly, 提示 With MSFlexGrid1 .Rows = .Rows + 1 .TextMatrix(.Rows - 1, 0) = Trim(Text1(0) .TextMatrix(.Rows - 1, 1) = Trim(Text1(1) .TextMatrix(.Rows - 1, 2) = Trim(Text1(2) .TextMatrix(.Rows - 1, 3) = Trim(Text1(3) .TextMatrix(.Rows - 1, 4) = Trim(Text1(4) .TextMatrix(.Rows - 1, 5) = Trim(Text1(5) .TextMatrix(.Rows - 1, 6) = Trim(Text1(6) .TextMatrix(.Rows - 1, 7) = Trim(Text1(7) If Text1(8) Label2(8).Caption Then .TextMatrix(.Rows - 1, 8) = Trim(Text1(8) End If End With MSFlexGrid1.TopRow = MSFlexGrid1.Rows - 1 TextDcolorEnd SubPrivate Sub Command2_Click() Dim j As Integer Dim txtSQL As String If Text1(5) Label2(5).Caption Then If IsDate(Text1(5) = False Then MsgBox 起始日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text1(5).SetFocus Exit Sub Else Text1(5) = Format(Text1(5), yyyy-mm-dd) End If End If If Text1(6) Label2(6).Caption Then If IsDate(Text1(6) = False Then MsgBox 起始日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text1(6).SetFocus Exit Sub Else Text1(6) = Format(Text1(6), yyyy-mm-dd) End If End If txtSQL = select * from student_Form If Text1(0) Label2(0).Caption Then txtSQL = txtSQL & where student_NO= & Trim(Text1(0) & End If If Text1(1) Label2(1).Caption Then If txtSQL = select * from student_Form Then txtSQL = txtSQL & where student_Name= & Trim(Text1(1) & Else txtSQL = txtSQL & and student_Name= & Trim(Text1(1) & End If End If If Text1(4) Label2(4).Caption Then If txtSQL = select * from student_Form Then txtSQL = txtSQL & where student_Cla= & Trim(Text1(4) & Else txtSQL = txtSQL & and student_Cla= & Trim(Text1(4) & End If End If If Text1(5) Label2(5).Caption And Text1(6) Label2(6).Caption Then If txtSQL = select * from student_Form Then txtSQL = txtSQL & where Format(student_Esd,yyyy-mm-dd) = & Trim(Text1(5) & and Format(student_Esd,yyyy-mm-dd) = & Trim(Text1(5) & and Format(student_Esd,yyyy-mm-dd) = & Trim(Text1(6) & End If End If Set mrc = ExecuteSQL(txtSQL, MsgText) j = 1 Do While Not mrc.EOF j = j + 1 mrc.MoveNext Loop ProgressBar1.Visible = True ProgressBar1.Min = CInt(0) ProgressBar1.Max = CInt(j) Set mrc = ExecuteSQL(txtSQL, MsgText) Frame1.Visible = True With MSFlexGrid1 .Visible = False .Rows = 1 ProgressBar1.Value = .Rows Do While Not mrc.EOF .Rows = .Rows + 1 For i = 0 To mrc.Fields.Count - 1 Select Case mrc.Fields(i).Type Case adDBDate .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i) & , yyyy-mm-dd) Case Else .TextMatrix(.Rows - 1, i) = mrc.Fields(i) & End Select Next i mrc.MoveNext Loop .Visible = True End With Frame1.Visible = False mrc.Close TextDcolor Text1(4).Visible = True Combo1.Visible = False Text1(2).Enabled = False Text1(3).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = FalseEnd SubPrivate Sub Command3_Click() Dim txtSQL As String Dim j As Integer For i = 0 To 7 If i 4 Then If Text1(i) = Label2(i).Caption Then MsgBox 请 & Label2(i).Caption & !, vbOKOnly, 提示 Text1(i).SetFocus Exit Sub End If Else If Text1(i) = Label2(i).Caption Then MsgBox 请 & Label2(i).Caption & !, vbOKOnly, 提示 Combo1.SetFocus Exit Sub End If End If Next If IsDate(Text1(3) = False Then MsgBox 出生日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text1(3).SetFocus Exit Sub End If If IsDate(Text1(6) = False Then MsgBox 入学日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text1(6).SetFocus Exit Sub End If txtSQL = delete from student_Form where student_NO= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) txtSQL = select * from student_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Fields(2) = Trim(Text1(2) mrc.Fields(3) = Trim(Text1(3) mrc.Fields(4) = Trim(Text1(4) mrc.Fields(5) = Trim(Text1(5) mrc.Fields(6) = Trim(Text1(6) mrc.Fields(7) = Trim(Text1(7) If Text1(8) = Label2(8).Caption Then mrc.Fields(8) = Else mrc.Fields(8) = Trim(Text1(8) End If mrc.Update mrc.Close MsgBox 学籍信息修改成功!, vbOKOnly, 提示 j = 0 For i = 1 To MSFlexGrid1.Rows - 1 If MSFlexGrid1.TextMatrix(i, 0) = Text1(0) Then j = i End If Next If j 0 Then MSFlexGrid1.TextMatrix(j, 0) = Trim(Text1(0) MSFlexGrid1.TextMatrix(j, 1) = Trim(Text1(1) MSFlexGrid1.TextMatrix(j, 2) = Trim(Text1(2) MSFlexGrid1.TextMatrix(j, 3) = Trim(Text1(3) MSFlexGrid1.TextMatrix(j, 4) = Trim(Text1(4) MSFlexGrid1.TextMatrix(j, 5) = Trim(Text1(5) MSFlexGrid1.TextMatrix(j, 6) = Trim(Text1(6) MSFlexGrid1.TextMatrix(j, 7) = Trim(Text1(7) If Text1(8) Label2(8).Caption Then MSFlexGrid1.TextMatrix(j, 8) = Trim(Text1(8) End If End If MSFlexGrid1.TopRow = j j = 0 TextDcolorEnd SubPrivate Sub Command4_Click() Dim txtSQL As String Dim j As Integer txtSQL = delete from student_Form where student_NO= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) MsgBox 学籍信息已经删除!, vbOKOnly, 提示 j = 0 For i = 1 To MSFlexGrid1.Rows - 1 If MSFlexGrid1.TextMatrix(i, 0) = Text1(0) Then j = i End If Next If j 0 Then MSFlexGrid1.TextMatrix(j, 0) = 已删除 MSFlexGrid1.TextMatrix(j, 1) = 已删除 MSFlexGrid1.TextMatrix(j, 2) = 已删除 MSFlexGrid1.TextMatrix(j, 3) = 已删除 MSFlexGrid1.TextMatrix(j, 4) = 已删除 MSFlexGrid1.TextMatrix(j, 5) = 已删除 MSFlexGrid1.TextMatrix(j, 6) = 已删除 MSFlexGrid1.TextMatrix(j, 7) = 已删除 MSFlexGrid1.TextMatrix(j, 8) = 已删除 End If j = 0 TextDcolor Text1(1).Enabled = False Text1(2).Enabled = False Text1(3).Enabled = False Combo1.Enabled = False Text1(4).Enabled = False Text1(5).Enabled = False Text1(6).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = FalseEnd SubPrivate Sub Command5_Click() TextDcolor If Label1(1).BackColor = &HFFFFFF Then MSFlexGrid1.Clear ShowTitle Text1(4).Visible = True Combo1.Visible = False Text1(2).Enabled = False Text1(3).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = False End If If Label1(3).BackColor = &HFFFFFF Then Text1(1).Enabled = False Text1(2).Enabled = False Text1(3).Enabled = False Combo1.Enabled = False Text1(4).Enabled = False Text1(5).Enabled = False Text1(6).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = False End IfEnd SubPrivate Sub Form_Load() Me.Caption = 学籍信息-查 询 ShowTitle Label1(1).BackColor = &HFFFFFF TextDcolor Text1(4).Visible = True Combo1.Visible = False Command1.Visible = False Command2.Visible = True Command3.Visible = False Command4.Visible = False Text1(2).Enabled = False Text1(3).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = FalseEnd SubPrivate Sub Form_Resize() dColor.ZOrder 1End SubPrivate Sub TextDcolor() Dim txtSQL As String For i = 0 To 8 Text1(i).Enabled = True Combo1.Enabled = True Text1(i).BackColor = &HE0E0E0 Text1(i) = Label2(i).Caption If i = 7 Or i = 8 Then Text1(i).Height = 300 End If Next Text1(4).Visible = False Combo1.Visible = True Combo1.Clear Combo1.AddItem Label2(4).Caption Combo1.BackColor = &HE0E0E0 Combo1.ListIndex = 0 txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = True Then MsgBox 请先进行班级设置!, vbOKOnly, 提示 Else With Combo1 Do While Not mrc.EOF .AddItem Trim(mrc!class_NO) mrc.MoveNext Loop End With End IfEnd SubPrivate Sub Label1_Click(Index As Integer) Me.Caption = 学籍信息- Me.Caption = Me.Caption & Trim(Label1(Index).Caption) Label1(0).BackColor = &HE0E0E0 Label1(1).BackColor = &HE0E0E0 Label1(2).BackColor = &HE0E0E0 Label1(3).BackColor = &HE0E0E0 Label1(Index).BackColor = &HFFFFFF Label2(4).Caption = 在此选择学号 Label2(5).Caption = 在此输入联系电话 Label2(6).Caption = 在此输入入学日期 Command5.SetFocus If Index = 0 Then TextDcolor Command1.Visible = True Command2.Visible = False Command3.Visible = False Command4.Visible = False End If If Index = 1 Then Label2(4).Caption = 在此输入学生学号 Label2(5).Caption = 查询入学日期起始 Label2(6).Caption = 查询入学日期截止 TextDcolor Text1(4).Visible = True Combo1.Visible = False Command1.Visible = False Command2.Visible = True Command3.Visible = False Command4.Visible = False Text1(2).Enabled = False Text1(3).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = False End If If Index = 2 Then TextDcolor Text1(0).SetFocus Command1.Visible = False Command2.Visible = False Command3.Visible = True Command4.Visible = False End If If Index = 3 Then TextDcolor Text1(0).SetFocus Command1.Visible = False Command2.Visible = False Command3.Visible = False Command4.Visible = True Text1(1).Enabled = False Text1(2).Enabled = False Text1(3).Enabled = False Combo1.Enabled = False Text1(4).Enabled = False Text1(5).Enabled = False Text1(6).Enabled = False Text1(7).Enabled = False Text1(8).Enabled = False End IfEnd SubPrivate Sub MSFlexGrid1_Click() If Label1(2).BackColor = &HFFFFFF Or Label1(3).BackColor = &HFFFFFF Then If MSFlexGrid1.Row 0 Then For i = 0 To 8 Text1(i) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, i) Next If Label1(2).BackColor = &HFFFFFF Then For i = 0 To 8 Text1(i).BackColor = &H8000000E Next End If If Label1(3).BackColor = &HFFFFFF Then Text1(0).BackColor = &H8000000E End If Text1(7).Height = 600 Text1(8).Height = 600 End If End IfEnd SubPrivate Sub Text1_Change(Index As Integer) If Label1(2).BackColor = &HFFFFFF Or Label1(3).BackColor = &HFFFFFF Then If Index = 0 Then tSQL = select * from student_Form where student_NO= & Trim(Text1(Index) & Set mrc = ExecuteSQL(tSQL, MsgText) If mrc.EOF = False Then For i = 1 To 8 Text1(i) = mrc.Fields(i) Next Combo1.Clear Combo1.AddItem Text1(4) Combo1.ListIndex = 0 txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then With Combo1 Do While Not mrc.EOF .AddItem Trim(mrc!class_NO) mrc.MoveNext Loop End With End If If Label1(2).BackColor = &HFFFFFF Then For i = 1 To 8 Text1(i).BackColor = &H8000000E Next Combo1.BackColor = &H8000000E End If Text1(7).Height = 600 Text1(8).Height = 600 Command3.Enabled = True Command4.Enabled = True Exit Sub Else For i = 1 To 8 Text1(i) = Label2(i).Caption Next Combo1.Clear Combo1.AddItem Label2(4).Caption Combo1.ListIndex = 0 If Label1(2).BackColor = &HFFFFFF Then For i = 1 To 8 Text1(i).BackColor = &HE0E0E0 Next Combo1.BackColor = &HE0E0E0 End If Text1(7).Height = 300 Text1(8).Height = 300 Command3.Enabled = False Command4.Enabled = False End If mrc.Close End If End IfEnd SubPrivate Sub Text1_Click(Index As Integer) If Index = 2 Then If Text1(Index) = 男 Then Text1(Index) = 女 Else Text1(Index) = 男 End If End IfEnd SubPrivate Sub Text1_GotFocus(Index As Integer) If Text1(Index) = Label2(Index).Caption Then Text1(Index).BackColor = &H8000000E Text1(Index) = If Index = 7 Or Index = 8 Then Text1(Index).Height = 600 End If End If Text1(Index).SelStart = 0 Text1(Index).SelLength = Len(Text1(Index)End SubPrivate Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) EnterToTab KeyCodeEnd SubPrivate Sub Text1_LostFocus(Index As Integer) If Text1(Index) = Then Text1(Index).BackColor = &HE0E0E0 Text1(Index) = Label2(Index).Caption If Index = 7 Or Index = 8 Then Text1(Index).Height = 300 End If End IfEnd SubPrivate Sub ShowTitle() Dim i As Integer With MSFlexGrid1 .Cols = 9 .TextMatrix(0, 0) = 学号 .TextMatrix(0, 1) = 姓名 .TextMatrix(0, 2) = 性别 .TextMatrix(0, 3) = 出生日期 .TextMatrix(0, 4) = 学生编号 .TextMatrix(0, 5) = 联系电话 .TextMatrix(0, 6) = 入学日期 .TextMatrix(0, 7) = 家庭住址 .TextMatrix(0, 8) = 备注信息 .ColWidth(0) = 1000 .ColWidth(1) = 1000 .ColWidth(2) = 1000 .ColWidth(3) = 1200 .ColWidth(4) = 1200 .ColWidth(5) = 1200 .ColWidth(6) = 1200 .ColWidth(7) = 3000 .ColWidth(8) = 6000 .Rows = 1 End WithEnd Sub7课程注册管理界面及程序代码图6Dim mrc As ADODB.RecordsetDim MsgText As StringPrivate Sub Combo1_Click() List1TextEnd SubPrivate Sub Command1_Click() Dim txtSQL As String If Text1(0) = Then MsgBox 课程名称不能为空!, vbOKOnly, 提示 Text1(0).SetFocus Exit Sub End If txtSQL = select * from course_Form where course_Name= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 此课程名称已经存在!, vbOKOnly, 警告 Text1(0).SetFocus Exit Sub End If mrc.Close txtSQL = select * from course_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Update mrc.Close Text1(0) = Text1(1) = MsgBox 课程信息添加成功!, vbOKOnly, 提示 List2TextEnd SubPrivate Sub Command2_Click() Dim txtSQL As String If List2.Text Then txtSQL = delete from course_Form where course_Name= & Trim(List2.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) MsgBox 课程信息已经删除!, vbOKOnly, 提示 List2Text End IfEnd SubPrivate Sub Form_Load() Dim txtSQL As String Me.Caption = 课程信息-设 置 txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = True Then MsgBox 请先进行班级设置!, vbOKOnly, 提示 Else With Combo1 Do While Not mrc.EOF .AddItem Trim(mrc!class_NO) mrc.MoveNext Loop Combo1.ListIndex = 0 End With End If List2TextEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label3(0).BackColor = &HC0C0C0 Label3(1).BackColor = &HC0C0C0 Label3(2).BackColor = &HC0C0C0 Label3(3).BackColor = &HC0C0C0End SubPrivate Sub Form_Resize() dColor.ZOrder 1End SubPrivate Sub Label3_Click(Index As Integer) Dim txtSQL As String Dim tSQL As String Dim mmrc As ADODB.Recordset If Index = 0 Then If Combo1.Text And List2.Text Then txtSQL = delete from class_Cour where class_NO= & Trim(Combo1.Text) & and course_Name= & Trim(List2.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) txtSQL = select * from class_Cour Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Combo1.Text) mrc.Fields(1) = Trim(List2.Text) mrc.Update mrc.Close End If End If If Index = 1 Then If Combo1.Text Then txtSQL = delete from class_Cour where class_NO= & Trim(Combo1.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) tSQL = select * from course_Form txtSQL = select * from class_Cour Set mmrc = ExecuteSQL(tSQL, MsgText) If mmrc.EOF = True Then MsgBox 请先进行班级设置!, vbOKOnly, 提示 Else Do While Not mmrc.EOF Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Combo1.Text) mrc.Fields(1) = mmrc.Fields(0) mrc.Update mrc.Close mmrc.MoveNext Loop End If End If End If If Index = 2 Then If Combo1.Text And List1.Text Then txtSQL = delete from class_Cour where class_NO= & Trim(Combo1.Text) & and course_Name= & Trim(List1.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) End If End If If Index = 3 Then If Combo1.Text Then txtSQL = delete from class_Cour where class_NO= & Trim(Combo1.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) End If End If txtSQL = select * from class_Cour Set mrc = ExecuteSQL(txtSQL, MsgText) List1TextEnd SubPrivate Sub Label3_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) Label3(Index).BackColor = &HFFFFFFEnd SubPrivate Sub List2_Click() Text1(0) = List2.TextEnd SubPrivate Sub Text1_Change(Index As Integer) Dim txSQL As String If Index = 0 Then txtSQL = select * from course_Form where course_Name= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then Text1(1) = mrc.Fields(1) Text1(1).Locked = True Else Text1(1) = Text1(1).Locked = False End If End IfEnd SubPrivate Sub Text1_GotFocus(Index As Integer) Text1(Index).SelStart = 0 Text1(Index).SelLength = Len(Text1(Index)End SubPrivate Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) EnterToTab KeyCodeEnd SubPrivate Sub List1Text() Dim txSQL As String Dim mrcc As ADODB.Recordset txSQL = select * from class_Cour where class_NO= & Trim(Combo1.Text) & Set mrcc = ExecuteSQL(txSQL, MsgText) List1.Clear Do While Not mrcc.EOF List1.AddItem Trim(mrcc!course_Name) mrcc.MoveNext Loop mrcc.CloseEnd SubPrivate Sub List2Text() Dim txSQL As String Dim mrcc As ADODB.Recordset txSQL = select * from course_Form Set mrcc = ExecuteSQL(txSQL, MsgText) List2.Clear Do While Not mrcc.EOF List2.AddItem Trim(mrcc!course_Name) mrcc.MoveNext Loop mrcc.CloseEnd Sub8成绩管理界面及程序代码图7Dim mrc As ADODB.RecordsetDim MsgText As StringPrivate Sub Combo1_Click(Index As Integer) Dim txSQL As String If Index = 0 Then txSQL = select * from student_Form where student_Cla= & Trim(Combo1(0).Text) & Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = True Then MsgBox 请先进行班级设置!, vbOKOnly, 提示 Else With Combo1(1) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!student_NO) mrc.MoveNext Loop End With End If txSQL = select * from class_Cour where class_NO= & Trim(Combo1(0).Text) & Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = True Then MsgBox 请先进行班级设置!, vbOKOnly, 提示 Else With Combo1(2) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!course_Name) mrc.MoveNext Loop End With End If End IfEnd SubPrivate Sub Combo2_Click(Index As Integer) Dim txSQL As String If Index = 0 Then txSQL = select DISTINCT score_Stu from score_Form where score_Cla= & Trim(Combo2(0).Text) & Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = False Then With Combo2(1) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!score_Stu) mrc.MoveNext Loop End With End If txSQL = select DISTINCT score_Cou from score_Form where score_Cla= & Trim(Combo2(0).Text) & Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = False Then With Combo2(2) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!score_Cou) mrc.MoveNext Loop End With End If End IfEnd SubPrivate Sub Combo3_Click(Index As Integer) Dim txSQL As String If Index = 0 Then txSQL = select * from student_Form where student_Cla= & Trim(Combo3(0).Text) & Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = False Then With Combo3(1) .Clear Do While Not mrc.EOF If mrc!student_NO .Text Then .AddItem Trim(mrc!student_NO) End If mrc.MoveNext Loop End With End If txSQL = select * from class_Cour where class_NO= & Trim(Combo3(0).Text) & Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = False Then With Combo3(2) .Clear Do While Not mrc.EOF If mrc!course_Name .Text Then .AddItem Trim(mrc!course_Name) End If mrc.MoveNext Loop End With End If End IfEnd SubPrivate Sub Command1_Click() Dim txtSQL As String If Text1(1) = Then MsgBox 考试期号不能为空!, vbOKOnly, 提示 Text1(1).SetFocus Exit Sub End If If Combo1(0).Text = Then MsgBox 学生班号不能为空!, vbOKOnly, 提示 Combo1(0).SetFocus Exit Sub End If If Combo1(1).Text = Then MsgBox 学生编号不能为空!, vbOKOnly, 提示 Combo1(1).SetFocus Exit Sub End If If Combo1(2).Text = Then MsgBox 考试课程不能为空!, vbOKOnly, 提示 Combo1(2).SetFocus Exit Sub End If If Text1(2) = Then MsgBox 考试分数不能为空!, vbOKOnly, 提示 Text1(2).SetFocus Exit Sub End If txtSQL = select * from score_Form where score_Per= & Trim(Text1(1) & and score_Cla= & Trim(Combo1(0).Text) & and score_Stu= & Trim(Combo1(1).Text) & And score_Cou= & Trim(Combo1(2).Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 同次同人同科只能添加一次, vbOKOnly, 警告 Text1(2) = Combo1(0).SetFocus Exit Sub End If txtSQL = select * from score_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Fields(2) = Trim(Combo1(0).Text) mrc.Fields(3) = Trim(Combo1(1).Text) mrc.Fields(4) = Trim(Combo1(2).Text) mrc.Fields(5) = Trim(Text1(2) mrc.Update mrc.Close MsgBox 考试信息添加成功!, vbOKOnly, 提示 With MSFlexGrid1 .Rows = .Rows + 1 .TextMatrix(.Rows - 1, 0) = Trim(Text1(0) .TextMatrix(.Rows - 1, 1) = Trim(Text1(1) .TextMatrix(.Rows - 1, 2) = Trim(Combo1(0).Text) .TextMatrix(.Rows - 1, 3) = Trim(Combo1(1).Text) .TextMatrix(.Rows - 1, 4) = Trim(Combo1(2).Text) .TextMatrix(.Rows - 1, 5) = Trim(Text1(2) End With Text1(2) = Combo1(0).Clear txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then With Combo1(0) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!class_NO) mrc.MoveNext Loop End With End If Combo1(1).Clear Combo1(2).Clear Text1(0) = GetRkno MSFlexGrid1.TopRow = MSFlexGrid1.Rows - 1End SubPrivate Sub Command2_Click() Dim txtSQL As String Text1(0) = GetRkno Text1(1) = Text1(2) = Combo1(0).Clear txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then With Combo1(0) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!class_NO) mrc.MoveNext Loop End With End If Combo1(1).Clear Combo1(2).ClearEnd SubPrivate Sub Command3_Click() Dim j As Long Dim txtSQL As String Dim txSQL As String txtSQL = select * from score_Form If Text2(1) Then txtSQL = txtSQL & where score_Per= & Trim(Text2(1) & End If If Combo2(0).Text Then If txtSQL = select * from score_Form Then txtSQL = txtSQL & where score_Cla= & Trim(Combo2(0).Text) & Else txtSQL = txtSQL & And score_Cla= & Trim(Combo2(0).Text) & End If End If If Combo2(1).Text Then If txtSQL = select * from score_Form Then txtSQL = txtSQL & where score_Stu= & Trim(Combo2(1).Text) & Else txtSQL = txtSQL & And score_Stu= & Trim(Combo2(1).Text) & End If End If If Combo2(2).Text Then If txtSQL = select * from score_Form Then txtSQL = txtSQL & where score_Cou= & Trim(Combo2(2).Text) & Else txtSQL = txtSQL & And score_Cou= & Trim(Combo2(2).Text) & End If End If Set mrc = ExecuteSQL(txtSQL, MsgText) j = 1 Do While Not mrc.EOF j = j + 1 mrc.MoveNext Loop ProgressBar1.Visible = True ProgressBar1.Min = CInt(0) ProgressBar1.Max = CInt(j) Set mrc = ExecuteSQL(txtSQL, MsgText) Frame1.Visible = True With MSFlexGrid1 .Visible = False .Rows = 1 ProgressBar1.Value = .Rows Do While Not mrc.EOF .Rows = .Rows + 1 For i = 0 To mrc.Fields.Count - 1 Select Case mrc.Fields(i).Type Case adDBDate .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i) & , yyyy-mm-dd) Case Else .TextMatrix(.Rows - 1, i) = mrc.Fields(i) & End Select Next i mrc.MoveNext Loop .Visible = True End With Frame1.Visible = False mrc.Close Text2(1) = txSQL = select DISTINCT score_Cla from score_Form Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = False Then With Combo2(0) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!score_Cla) mrc.MoveNext Loop End With End If Combo2(1).Clear Combo2(2).Clear Text2(2) = End SubPrivate Sub Command4_Click() Dim txtSQL As String Text2(1) = txtSQL = select DISTINCT score_Cla from score_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then With Combo2(0) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!score_Cla) mrc.MoveNext Loop End With End If Combo2(1).Clear Combo2(2).Clear Text2(2) = End SubPrivate Sub Command5_Click() Dim j As Integer Dim txtSQL As String If Text3(0) = Then MsgBox 清选择要修改的纪录!, vbOKOnly, 提示 MSFlexGrid1.SetFocus Exit Sub End If If Text3(1) = Then MsgBox 考试期号不能为空!, vbOKOnly, 提示 Text3(1).SetFocus Exit Sub End If If Combo3(0).Text = Then MsgBox 学生班号不能为空!, vbOKOnly, 提示 Combo3(0).SetFocus Exit Sub End If If Combo3(1).Text = Then MsgBox 学生编号不能为空!, vbOKOnly, 提示 Combo3(1).SetFocus Exit Sub End If If Combo3(2).Text = Then MsgBox 考试课程不能为空!, vbOKOnly, 提示 Combo3(2).SetFocus Exit Sub End If If Text3(2) = Then MsgBox 考试分数不能为空!, vbOKOnly, 提示 Text3(2).SetFocus Exit Sub End If txtSQL = select * from score_Form where score_NO & Trim(Text3(0) & And score_Per= & Trim(Text3(1) & and score_Cla= & Trim(Combo3(0).Text) & and score_Stu= & Trim(Combo3(1).Text) & And score_Cou= & Trim(Combo3(2).Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 同次同人同科只能添加一次, vbOKOnly, 警告 Text3(2) = Combo3(0).SetFocus Exit Sub End If txtSQL = Delete from score_Form where score_NO= & Trim(Text3(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) txtSQL = select * from score_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text3(0) mrc.Fields(1) = Trim(Text3(1) mrc.Fields(2) = Trim(Combo3(0).Text) mrc.Fields(3) = Trim(Combo3(1).Text) mrc.Fields(4) = Trim(Combo3(2).Text) mrc.Fields(5) = Trim(Text3(2) mrc.Update mrc.Close MsgBox 考试信息修改成功!, vbOKOnly, 提示 j = 0 For i = 1 To MSFlexGrid1.Rows - 1 If MSFlexGrid1.TextMatrix(i, 0) = Text3(0) Then j = i End If Next If j 0 Then With MSFlexGrid1 .TextMatrix(j, 0) = Trim(Text3(0) .TextMatrix(j, 1) = Trim(Text3(1) .TextMatrix(j, 2) = Trim(Combo3(0).Text) .TextMatrix(j, 3) = Trim(Combo3(1).Text) .TextMatrix(j, 4) = Trim(Combo3(2).Text) .TextMatrix(j, 5) = Trim(Text3(2) End With End If Text3(0) = Text3(1) = Combo3(0).Clear Combo3(1).Clear Combo3(2).Clear Text3(2) = MSFlexGrid1.TopRow = j j = 0End SubPrivate Sub Command6_Click() Text3(0) = Text3(1) = Combo3(0).Clear Combo3(1).Clear Combo3(2).Clear Text3(2) = End SubPrivate Sub Command7_Click() Dim j As Integer Dim txtSQL As String If Text4(0) = Then MsgBox 清选择要删除的纪录!, vbOKOnly, 提示 MSFlexGrid1.SetFocus Exit Sub End If txtSQL = Delete from score_Form where score_NO= & Trim(Text4(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) MsgBox 考试信息修改成功!, vbOKOnly, 提示 j = 0 For i = 1 To MSFlexGrid1.Rows - 1 If MSFlexGrid1.TextMatrix(i, 0) = Text4(0) Then j = i End If Next If j 0 Then With MSFlexGrid1 .TextMatrix(j, 0) = 已删除 .TextMatrix(j, 1) = 已删除 .TextMatrix(j, 2) = 已删除 .TextMatrix(j, 3) = 已删除 .TextMatrix(j, 4) = 已删除 .TextMatrix(j, 5) = 已删除 End With End If Text4(0) = Text4(1) = Combo4(0).Clear Combo4(1).Clear Combo4(2).Clear Text4(2) = End SubPrivate Sub Command8_Click() Text4(0) = Text4(1) = Combo4(0).Clear Combo4(1).Clear Combo4(2).Clear Text4(2) = End SubPrivate Sub Form_Load() Option1(1).Value = True Picture1(0).Visible = False Picture1(1).Visible = True Picture1(2).Visible = False Picture1(3).Visible = False Picture1(1).Top = Picture1(0).Top Picture1(1).Left = Picture1(0).Left Picture1(2).Top = Picture1(0).Top Picture1(2).Left = Picture1(0).Left Picture1(3).Top = Picture1(0).Top Picture1(3).Left = Picture1(0).Left With MSFlexGrid1 .Cols = 6 .TextMatrix(0, 1) = 考试期号 .TextMatrix(0, 2) = 学生班号 .TextMatrix(0, 3) = 学生编号 .TextMatrix(0, 4) = 考试课程 .TextMatrix(0, 5) = 考试分数 .ColWidth(0) = 0 .ColWidth(1) = 1550 .ColWidth(2) = 1550 .ColWidth(3) = 1550 .ColWidth(4) = 1550 .ColWidth(5) = 1550 .Rows = 1 End With Text1(0) = GetRknoEnd SubPrivate Sub Form_Resize() dColor.ZOrder 1End SubPrivate Sub MSFlexGrid1_Click() Dim txtSQL As String If MSFlexGrid1.Row 0 Then Text3(0) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0) Text3(1) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 1) Combo3(0).Clear Combo3(0).AddItem MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 2) Combo3(0).ListIndex = 0 txtSQL = select * from class_Form Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then With Combo3(0) Do While Not mrc.EOF If mrc!class_NO .Text Then .AddItem Trim(mrc!class_NO) End If mrc.MoveNext Loop End With End If Combo3(1).Clear Combo3(1).AddItem MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) Combo3(1).ListIndex = 0 Combo3(2).Clear Combo3(2).AddItem MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 4) Combo3(2).ListIndex = 0 Text3(2) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 5) Text4(0) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0) Text4(1) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 1) Combo4(0).Clear Combo4(0).AddItem MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 2) Combo4(0).ListIndex = 0 Combo4(1).Clear Combo4(1).AddItem MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) Combo4(1).ListIndex = 0 Combo4(2).Clear Combo4(2).AddItem MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 4) Combo4(2).ListIndex = 0 Text4(2) = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 5) End IfEnd SubPrivate Sub Option1_Click(Index As Integer) Dim txSQL As String Me.Caption = 成绩信息- Me.Caption = Me.Caption & Option1(Index).Caption Option1(0).BackColor = &HC0C0C0 Option1(1).BackColor = &HC0C0C0 Option1(2).BackColor = &HC0C0C0 Option1(3).BackColor = &HC0C0C0 Option1(Index).BackColor = &H80000005 Picture1(0).Visible = False Picture1(1).Visible = False Picture1(2).Visible = False Picture1(3).Visible = False Picture1(Index).Visible = True txSQL = select * from class_Form Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = True Then MsgBox 请先进行班级设置!, vbOKOnly, 提示 Else With Combo1(0) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!class_NO) mrc.MoveNext Loop End With End If txSQL = select DISTINCT score_Cla from score_Form Set mrc = ExecuteSQL(txSQL, MsgText) If mrc.EOF = False Then With Combo2(0) .Clear Do While Not mrc.EOF .AddItem Trim(mrc!score_Cla) mrc.MoveNext Loop End With End If Text3(0) = Text3(1) = Combo3(0).Clear Combo3(1).Clear Combo3(2).Clear Text3(2) = Text4(0) = Text4(1) = Combo4(0).Clear Combo4(1).Clear Combo4(2).Clear Text4(2) = End SubPrivate Function GetRkno() As String GetRkno = Format(Now, yymmddhhmmss) Randomize GetRkno = GetRkno & Int(99 - 10 + 1) * Rnd + 10)End FunctionPrivate Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) If Index = 2 Then If KeyAscii = 190 Then If InStr(Trim(Text1(Index), .) = 0 Then If Len(Trim(Text1(Index) 0 Then Text1(Index).Locked = False Else Text1(Index).Locked = True End If Else Text1(Index).Locked = True End If Exit Sub End If If KeyAscii 57 Or KeyAscii 0 Then Text1(Index).Locked = False Else Text1(Index).Locked = True End If Else Text1(Index).Locked = True End If Exit Sub End If If KeyAscii 57 Or KeyAscii 48 Then Text1(Index).Locked = True Else Text1(Index).Locked = False End If If KeyAscii = 8 Then Text1(Index).Locked = False End If If KeyAscii = 46 Then Text1(Index).Locked = False End If End IfEnd Sub9奖罚管理界面及程序代码图8Dim mrc As ADODB.RecordsetDim MsgText As StringPrivate Sub Command1_Click() Dim txtSQL As String If Text1(0) = Then MsgBox 奖惩名称不能为空!, vbOKOnly, 提示 Text1(0).SetFocus Exit Sub End If txtSQL = select * from prize_Form where prize_Name= & Trim(Text1(0) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox 此奖惩名称已经存在!, vbOKOnly, 警告 Text1(0).SetFocus Exit Sub End If mrc.Close txtSQL = select * from prize_Form Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text1(0) mrc.Fields(1) = Trim(Text1(1) mrc.Update mrc.Close Text1(0) = Text1(1) = MsgBox 奖惩信息添加成功!, vbOKOnly, 提示 List1TextEnd SubPrivate Sub Command2_Click() If List1.Text Then txtSQL = delete from prize_Form where prize_Name= & Trim(List1.Text) & Set mrc = ExecuteSQL(txtSQL, MsgText) MsgBox 奖惩信息已经删除!, vbOKOnly, 提示 List1Text End IfEnd SubPrivate Sub Form_Load() MSFlexGrid1.Cols = 5 MSFlexGrid1.ColWidth(0) = 300 MSFlexGrid1.ColWidth(1) = 0 MSFlexGrid1.ColWidth(2) = 0 MSFlexGrid1.ColWidth(3) = 1200 MSFlexGrid1.ColWidth(4) = 1200 MSFlexGrid1.TextMatrix(0, 3) = 奖惩日期 MSFlexGrid1.TextMatrix(0, 4) = 奖惩名称 MSFlexGrid1.Rows = 1 Text3(0) = GetRkno List1TextEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label6(0).BackColor = &HC0C0C0 Label6(1).BackColor = &HC0C0C0End SubPrivate Sub Form_Resize() dColor.ZOrder 1End SubPrivate Sub List1Text() Dim txSQL As String Dim mrcc As ADODB.Recordset txSQL = select * from prize_Form Set mrcc = ExecuteSQL(txSQL, MsgText) List1.Clear Do While Not mrcc.EOF List1.AddItem Trim(mrcc!prize_Name) mrcc.MoveNext Loop mrcc.CloseEnd SubPrivate Function GetRkno() As String GetRkno = Format(Now, yymmddhhmmss) Randomize GetRkno = GetRkno & Int(99 - 10 + 1) * Rnd + 10)End FunctionPrivate Sub Label6_Click(Index As Integer) Dim txtSQL As String If Index = 0 Then If Text2 = Then MsgBox 请输入学号!, vbOKOnly, 提示 Text2.SetFocus Exit Sub Else txtSQL = select * from student_Form where student_NO= & Trim(Text2) & Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = True Then MsgBox 请确认此学号的学籍信息已存在!, vbOKOnly, 警告 Text2.SetFocus Exit Sub End If mrc.Close End If If Text3(1) = Then MsgBox 请输入奖惩日期!, vbOKOnly, 提示 Text3(1).SetFocus Exit Sub Else If IsDate(Text3(1) = False Then MsgBox 奖惩日期应为日期格式(yyyy-mm-dd)!, vbOKOnly, 警告 Text3(1).SetFocus Exit Sub End If End If If List1.Text = Then MsgBox 请选择奖惩名称!, vbOKOnly, 提示 List1.SetFocus Exit Sub End If txtSQL = select * from prize_Stud Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(Text3(0) mrc.Fields(1) = Trim(Text2) mrc.Fields(2) = Trim(Text3(1) mrc.Fields(3) = Trim(List1.Text) mrc.Update mrc.Close Set mrc = ExecuteSQL(txtSQL, MsgText) txtSQL = select * from prize_Stud where prize_Stu= & Trim(Text2) & Set mrc = ExecuteSQL(txtSQL, MsgText) ShowData Text3(0
- 温馨提示:
1: 本站所有资源如无特殊说明，都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
2: 本站的文档不包含任何第三方提供的附件图纸等，如果需要附件，请联系上传者。文件的所有权益归上传用户所有。
3.本站RAR压缩包中若带图纸，网页内容里面会有图纸预览，若没有图纸预览就没有图纸。
4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
5. 人人文库网仅提供信息存储空间，仅对用户上传内容的表现方式做保护处理，对用户上传分享的文档内容本身不做任何修改或编辑，并不能对任何下载内容负责。
6. 下载文件中如有侵权或不适当内容，请与我们联系，我们立即纠正。
7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
人人文库网所有资源均是用户自行上传分享，仅供网友学习交流，未经上传用户书面授权，请勿作他用。
川公网安备: 51019002004831号