文件名称：用VB编写的学生学籍管理
文件大小：1.11MB
文件格式：RAR
更新时间：2011-12-24 08:32:24
用VB编写的学生学籍管理
Dim i, j, n As Integer Dim sql As String Private Declare Function GetKeyState Lib "user32" _ (ByVal nVirtKey As Long) As Integer Public je As Integer '记忆菜单上次数值，实现数据传送 Private Sub acg_Click() Call asPopup7_Click(False) End Sub Private Sub addcg_Click() Call asPopup6_Click(False) End Sub Private Sub addstudent_Click() Call asPopup2_Click(False) End Sub Private Sub asPopup1_Click(Cancel As Boolean) Grid1.Visible = True Grid2.Visible = False tkbase = "学生信息" fnumber = 13 sql = "select * from " & tkbase grid1pz '执行grid1的分配空间任务 datagrid '按要求读取数据空间 End Sub Private Sub grid1pz() Grid1.Cols = fnumber + 1 Grid1.Column(1).Width = 120 Grid1.Column(2).Width = 100 Grid1.Column(3).Width = 80 Grid1.Column(4).Width = 40 Grid1.Column(5).Width = 80 Grid1.Column(6).Width = 30 Grid1.Column(7).Width = 100 Grid1.Column(8).Width = 200 Grid1.Column(9).Width = 60 Grid1.Column(10).Width = 80 Grid1.Column(11).Width = 100 Grid1.Column(12).Width = 100 Grid1.Column(13).Width = 100 Grid1.Column(4).CellType = cellComboBox Grid1.ComboBox(4).Clear Grid1.ComboBox(4).AddItem "男" Grid1.ComboBox(4).AddItem "女" Grid1.Column(5).CellType = cellCalendar Grid1.Column(1).Locked = True End Sub Private Sub asPopup2_Click(Cancel As Boolean) Grid1.Visible = True Grid2.Visible = False tkbase = "学生信息" fnumber = 13 Set qy1 = cnn.Execute("select * from " & tkbase) grid1pz For i = 1 To fnumber Grid1.Cell(0, i).Text = qy1.Fields(i - 1).Name Next Grid1.Column(1).Locked = False Grid1.Rows = 1 Grid1.Rows = 21 gridsave = True '允许保存 griddelete = False '拒绝删除 gridedit = False End Sub Private Sub asPopup3_Click(Cancel As Boolean) Dim fo2 As CTranslucentForm Set fo2 = New CTranslucentForm fo2.hWnd = Form2.hWnd fo2.Alpha = 90 / 100 * 255 Me.WindowState = vbMinimized Load Form2 Form2.Show 1 End Sub Private Sub asPopup4_Click(Cancel As Boolean) Dim fo2 As CTranslucentForm Set fo2 = New CTranslucentForm fo2.hWnd = Form4.hWnd fo2.Alpha = 90 / 100 * 255 Me.WindowState = vbMinimized Load Form4 Form4.Show 1 End Sub Private Sub asPopup5_Click(Cancel As Boolean) MsgBox "非完整源码不可查询！" End Sub Private Sub asPopup6_Click(Cancel As Boolean) Grid1.Visible = False Grid2.Visible = True tkbase = "学生与课程" fnumber = 5 gridpz2 Set qy1 = cnn.Execute("select * from " & tkbase) For i = 1 To fnumber Grid2.Cell(0, i).Text = qy1.Fields(i - 1).Name Next Grid2.Rows = 1 Grid2.Rows = 21 gridsave = True gridedit = False griddel = False Grid2.Column(1).Locked = False Grid2.Column(2).Locked = False Grid2.Column(3).Locked = False End Sub Private Sub asPopup7_Click(Cancel As Boolean) Grid1.Visible = False Grid2.Visible = True tkbase = "学生与课程" fnumber = 5 sql = "select * from " & tkbase gridpz2 datagrid gridsave = False gridedit = True griddel = True Grid2.Column(1).Locked = True Grid2.Column(2).Locked = True Grid2.Column(3).Locked = True End Sub Private Sub gridpz2() Grid2.Cols = 7 Grid2.Column(1).CellType = cellComboBox Set qy1 = cnn.Execute("select 课程号 from 课程") Grid2.ComboBox(1).Clear Do While Not qy1.EOF Grid2.ComboBox(1).AddItem qy1.Fields(0) qy1.MoveNext Loop Grid2.Column(2).CellType = cellComboBox Set qy1 = cnn.Execute("select 课程名称 from 课程") Grid2.ComboBox(2).Clear Do While Not qy1.EOF Grid2.ComboBox(2).AddItem qy1.Fields(0) qy1.MoveNext Loop End Sub Private Sub asPopup9_Click(Cancel As Boolean) End End Sub Private Sub c1_Click(Index As Integer) '提交内容到函数执行，4为当前菜单（0-4），index是按钮数组名称 cmove 4, Index End Sub Private Sub cmove(s As Integer, i As Integer) '菜单智能移动函数代码 Dim j As Integer Dim X, Y, z, x1, y1 As Integer X = s Y = s z = s x1 = s j = 0 Do While s > 0 If je > i Then Do While X > i Do While Y >= X j = j + 360 Y = Y - 1 Loop c1(X).Top = Fre1.Height - j X = X - 1 Loop Else '-----------------向上代码 For X = 0 To i For Y = 0 To X j = j + 360 Next c1(X).Top = j - 360 j = 0 Next End If s = s - 1 For y1 = 0 To x1 If y1 = i Then Fre2(y1).Visible = True Fre2(y1).Top = c1(y1).Top + c1(y1).Height If y1 <> z Then Fre2(y1).Height = c1(y1 + 1).Top - Fre2(y1).Top Else Fre2(y1).Height = Fre1.Height - c1(y1).Top - c1(y1).Height End If Else Fre2(y1).Visible = False End If Next Loop je = i End Sub Private Sub cgdel_Click() Call XPButton6_Click End Sub Private Sub cgedit_Click() Call XPButton4_Click End Sub Private Sub delstudent_Click() Call XPButton6_Click End Sub Private Sub editstudent_Click() Call XPButton4_Click End Sub Private Sub findcg_Click() If hang = 0 Then Exit Sub End If Grid1.Visible = False Grid2.Visible = True tkbase = "学生与课程" fnumber = 5 sql = "select * from 学生与课程 where 学号='" & Grid1.Cell(hang, 1).Text & "'" gridpz2 datagrid gridsave = False gridedit = True griddel = True Grid2.Column(1).Locked = True Grid2.Column(2).Locked = True Grid2.Column(3).Locked = True End Sub Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu student End If End Sub Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long) hang = Row If gridsave = True And Col = 5 Then '确认默认年龄在20岁左右 If Row <> 0 Then Grid1.Cell(Row, 5).Text = Date - 7300 End If End If End Sub Private Sub Grid1_Validate(Cancel As Boolean) '设定TAB键切换 Dim nActiveRow As Long, nActiveCol As Long Const VK_TAB = 9 If GetKeyState(VK_TAB) < 0 Then nActiveRow = Grid1.ActiveCell.Row nActiveCol = Grid1.ActiveCell.Col If nActiveCol < Grid1.Cols - 1 Then Grid1.Range(nActiveRow, nActiveCol + 1, _ nActiveRow, nActiveCol + 1).Selected End If Cancel = True End If End Sub Private Sub Form_Load() form1.BackColor = RGB(168, 217, 189) With Grid1 .AllowUserResizing = True .DisplayFocusRect = False .ExtendLastCol = True .Appearance = Flat .FixedRowColStyle = Flat .ScrollBarStyle = Flat .DefaultFont.Name = "Tahoma" .DefaultFont.Size = 8 .BackColorFixed = RGB(84, 201, 134) .BackColorFixedSel = RGB(84, 201, 134) .BackColorBkg = RGB(198, 229, 211) .BackColorScrollBar = RGB(198, 229, 211) .BackColor1 = RGB(231, 235, 247) .BackColor2 = RGB(198, 229, 211) .GridColor = RGB(148, 190, 231) .Column(0).Width = 0 End With With Grid2 .AllowUserResizing = True .DisplayFocusRect = False .ExtendLastCol = True .Appearance = Flat .FixedRowColStyle = Flat .ScrollBarStyle = Flat .AllowUserResizing = True .DisplayFocusRect = False .ExtendLastCol = True .Appearance = Flat .FixedRowColStyle = Flat .ScrollBarStyle = Flat .DefaultFont.Name = "Tahoma" .DefaultFont.Size = 8 .BackColorFixed = RGB(84, 201, 134) .BackColorFixedSel = RGB(84, 201, 134) .BackColorBkg = RGB(198, 229, 211) .BackColorScrollBar = RGB(198, 229, 211) .BackColor1 = RGB(231, 235, 247) .BackColor2 = RGB(198, 229, 211) .GridColor = RGB(148, 190, 231) .Column(0).Width = 0 End With je = 4 Dim fr As Integer Fre1.BackColor = RGB(168, 217, 189) For fr = 0 To 4 Fre2(fr).Visible = False Fre2(fr).BackColor = RGB(168, 217, 189) Next Grid2.Visible = False Call c1_Click(0) End Sub Private Sub Grid2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then MsgBox "非完整源码不支持鼠标右键！" End If End Sub Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long) hang = Row End Sub Private Sub datagrid() griddelete = True '允许删除 gridedit = True If tkbase = "学生信息" Then If qy1.State = adStateOpen Then '表状态 qy1.Close End If qy1.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText For i = 1 To fnumber Grid1.Cell(0, i).Text = qy1.Fields(i - 1).Name Next qy1.PageSize = 20 nnum = qy1.PageCount If qy1.PageCount = 0 Then nnum = 1 End If numpage = 1 Label1.Caption = "共" & nnum & "页 第" & numpage & "页" Grid1.Rows = 1 Grid1.Rows = 21 If qy1.RecordCount = 0 Then Exit Sub End If qy1.AbsolutePage = numpage For i = 1 To qy1.PageSize '设定读取行 For j = 1 To fnumber '设定读取列 If qy1.EOF = True Then Exit Sub End If If qy1.Fields(j - 1) <> noNull Then '空值的处理 Grid1.Cell(i, j).Text = qy1.Fields(j - 1) Else Grid1.Cell(i, j).Text = "" End If Next If qy1.EOF = False Then qy1.MoveNext '读取下一记录 Else Exit Sub End If Next ElseIf tkbase = "学生与课程" Then If qy1.State = adStateOpen Then '表状态 qy1.Close End If qy1.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText For i = 1 To fnumber Grid2.Cell(0, i).Text = qy1.Fields(i - 1).Name Next qy1.PageSize = 20 nnum = qy1.PageCount If qy1.PageCount = 0 Then nnum = 1 End If numpage = 1 Label1.Caption = "共" & nnum & "页 第" & numpage & "页" Grid2.Rows = 1 Grid2.Rows = 21 If qy1.RecordCount = 0 Then Exit Sub End If qy1.AbsolutePage = numpage For i = 1 To qy1.PageSize '设定读取行 For j = 1 To fnumber '设定读取列 If qy1.EOF = True Then Exit Sub End If If qy1.Fields(j - 1) <> noNull Then '空值的处理 Grid2.Cell(i, j).Text = qy1.Fields(j - 1) Else Grid2.Cell(i, j).Text = "" End If Next If qy1.EOF = False Then qy1.MoveNext '读取下一记录 Else Exit Sub End If Next End If End Sub Private Sub Grid2_Validate(Cancel As Boolean) Dim nActiveRow As Long, nActiveCol As Long Const VK_TAB = 9 If GetKeyState(VK_TAB) < 0 Then nActiveRow = Grid1.ActiveCell.Row nActiveCol = Grid1.ActiveCell.Col If nActiveCol < Grid1.Cols - 1 Then Grid1.Range(nActiveRow, nActiveCol + 1, _ nActiveRow, nActiveCol + 1).Selected End If Cancel = True End If End Sub Private Sub renovate_Click() Call asPopup1_Click(False) End Sub Private Sub returncg_Click() Grid1.Visible = True Grid2.Visible = False End Sub Private Sub savestudent_Click() Call XPButton5_Click End Sub Private Sub XPButton1_Click() MsgBox "非完整源码只可显示20条记录！" End Sub Private Sub XPButton2_Click() MsgBox "非完整源码只可显示20条记录！" End Sub Private Sub XPButton4_Click() If gridedit = False Then MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象" Exit Sub End If If hang = 0 Then Exit Sub End If Dim delok As String End Sub Private Sub XPButton5_Click() If tkbase = "" Then MsgBox "表指向不明，请确认", vbInformation, "提示" Exit Sub End If If gridsave = False Then MsgBox "当前不允许保存！", vbInformation, "提示" Exit Sub End If Select Case tkbase Case "学生信息" For i = 1 To 20 '处理重名数据 If Grid1.Cell(i, 1).Text <> "" Then Set qy1 = cnn.Execute("select 学号 from 学生信息 where 学号='" & Grid1.Cell(i, 1).Text & "'") If qy1.EOF = False Then MsgBox "第" & i & "行的学号在数据库里出现重复，请检查", vbInformation, "错误" Grid1.Cell(i, 1).SetFocus Exit Sub End If End If Next For i = 1 To 20 For n = 1 To fnumber Select Case n Case 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 If Grid1.Cell(i, 1).Text <> "" Then If Grid1.Cell(i, n).Text = "" Then MsgBox "第" & i & "行的--[" & Grid1.Cell(0, n).Text & "]--字段不允许为空!", vbInformation, "提示" Grid1.Cell(i, n).SetFocus Exit Sub End If End If End Select Next If Grid1.Cell(i, 1).Text <> "" Then sql = "insert into " & tkbase & " values('" For j = 1 To fnumber - 1 sql = sql & Grid1.Cell(i, j).Text & "','" Next sql = sql & Grid1.Cell(i, fnumber).Text & "')" Set qy1 = cnn.Execute(sql) End If Next MsgBox "命令执行完毕!", vbInformation, "完成" Grid1.Rows = 1 Grid1.Rows = 21 Case "学生与课程" MsgBox "非完整源码不可保证学生与课程的记录！" End Select gridsave = False griddelete = False '拒绝删除 gridedit = False End Sub Private Sub XPButton6_Click() If griddelete = False Then MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象" Exit Sub End If If hang = 0 Then Exit Sub End If Dim delok As String Select Case tkbase Case "学生信息" MsgBox "非完整源码不可修改！" Case "学生与课程" If Grid2.Cell(hang, 1).Text = "" Then Exit Sub End If delok = MsgBox("确认删除" & Grid2.Cell(hang, 3).Text & "的<" & Grid2.Cell(hang, 2).Text & ">成绩吗？？", vbQuestion + vbOKCancel, "注意:此操作将会将学生资料与成绩资料完全清除") If delok = vbOK Then sql = "delete from " & tkbase & " where 学号='" & Grid2.Cell(hang, 3).Text & "' and 课程号='" & Grid2.Cell(hang, 1).Text & "'" Set qy1 = cnn.Execute(sql) MsgBox "目标己删除完成!", , "提示" End If End Select End Sub Private Sub XPButton8_Click(Index As Integer) Call findcg_Click End Sub
【文件预览】：
学生学籍系统(ACCESS)
----学籍系统.vbp(1KB)
----base.mdb(696KB)
----Form1.log(9KB)
----Form1.frm(30KB)
----StoneXP.oca(83KB)
----as97Popup.ocx(75KB)
----Form4.log(2KB)
----工程1.vbp(645B)
----StoneXP.ocx(308KB)
----FlexCell.oca(80KB)
----MSSCCPRJ.SCC(339B)
----Form2.frm(9KB)
----学籍系统.vbw(349B)
----hand.cur(326B)
----Form1.frx(262KB)
----使用必看.txt(274B)
----Form3.frx(126KB)
----FlexCell.ocx(1.87MB)
----Thumbs.db(6KB)
----Form4.frm(8KB)
----学籍系统.PDM(5KB)
----工程1.vbw(52B)
----学籍系统.exe(992KB)
----as97Popup.oca(27KB)
----Form2.frx(66KB)
----Form3.frm(3KB)
----bas()
--------CTranslucent.cls(7KB)
--------accesscnn.bas(2KB)
--------bsdim.bas(440B)
--------ModAPIWindows.bas(2KB)
----Form2.log(2KB)
----Form4.frx(66KB)
----Fauxs-xp (oynx) v2 icon 02.ico(62KB)