VBA与excel实现学生管理系统 代码

适合学习者或具体有中级编程水平的朋友学习 

完整代码连接：https://wenku.baidu.com/view/111e5e60760bf78a6529647d27284b73f2423684

'以下为部分代码，要想完美运行去上面连接下载或找Q523857886索取

'公共变量模块

Public ClassName

Public Class

Public n

Public m As Integer

Public p As Integer

'子程序模块

Public Sub 年级班级()

Dim i As Integer, j As Integer, nmax As Integer

Dim ws As Worksheet

Set ws = Worksheets("班级管理")

m = ws.Range("IV1").End(xlToLeft).Column  'End(xlToLeft)是向左查询，直到最后一个非空数据下截止，并将其数值附上。

ReDim n(1 To m) As Integer

ReDim Class(1 To m) As String

nmax = ws.UsedRange.Rows.Count - 1

ReDim ClassName(1 To m, 1 To nmax) As String

For j = 1 To m

n(j) = ws.Cells(65536, j).End(xlUp).Row - 1

Class(j) = ws.Cells(1, j)

  For i = 1 To n(j)

  ClassName(j, i) = ws.Cells(1 + i, j)

  Next i

Next j

End Sub

‘自定义按钮的指定宏模块

Sub 管理学生名单()

Call 管理1.Show

End Sub

Sub 管理学生成绩()

管理学生成绩1.Show

End Sub

Sub 查询学生成绩()

查询学生成绩1.Show

End Sub

Sub 成绩统计分析()

成绩统计分析1.Show

End Sub

Sub 打印成绩单()

Print1.Show

End Sub

Sub 班级管理()

Worksheets("班级管理").Visible = True  '显示工作表"班级管理"

Worksheets("班级管理").Activate      '激活工作表"班级管理"

End Sub

‘5个窗体

‘管理1  管理学生成绩1 成绩统计1 查询学生成绩1 print1

'管理1

Private Sub CommandButton1_Click()

Dim i As Integer

For i = 1 To TreeView1.Nodes.Count

    TreeView1.Nodes(i).Expanded = False

Next

End Sub

Private Sub CommandButton2_Click()

'On Error Resume Next

Dim ws As Worksheet

Dim i As Integer, j As Integer, k As Integer

Dim clas As String

Dim classNam As String

'以下功能是发现班级不在就建立所有不在的班级

For j = 1 To m

  For i = 1 To n(j)


  For k = 1 To Worksheets.Count

    If Worksheets(k).Name = Class(j) & Space(1) & ClassName(j, i) Then Exit For

  Next k

  If k > Worksheets.Count Then 'k>count说明没找到对应班级，所以要建立班级

    Worksheets.Add after:=Worksheets(Worksheets.Count)

    ActiveSheet.Name = Class(j) & Space(1) & ClassName(j, i)


    Range("A1:k1").Select

    Selection = Array("学号", "姓名 ", "性别 ", "数学 ", "语文 ", "英语 ", "物理 ", "化学 ", "生物", "体育", "总分")

    Selection.HorizontalAlignment = xlCenter '标题文字居中

    Columns("A:A").NumberFormatLocal = "@" 'A列数据为文本

    End If

    Next i

    Next j

    Worksheets("首页").Activate

    ActiveSheet.Range("A2").Select

End Sub

Private Sub CommandButton3_Click()

End

End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)

On Error Resume Next

'显示并激活某班工作表

Dim i As Integer

For i = 1 To Worksheets.Count

If Worksheets(i).Name <> "首页" And Worksheets(i).Name <> Node.Key Then

    Worksheets(i).Visible = False '保护除工作表“首页”外的所有工作表

End If

Next i

Worksheets(Node.Key).Visible = True

Worksheets(Node.Key).Activate

End Sub

Private Sub UserForm_Initialize()

Dim i As Integer, j As Integer

Call 年级班级

TreeView1.Nodes.Clear

TreeView1.LineStyle = tvwRootLines

TreeView1.LabelEdit = tvwManual

For j = 1 To m

Set nodx = TreeView1.Nodes.Add(, , Class(j), Class(j))

Next j

For j = 1 To m

      For i = 1 To n(j)

        Set nodx = TreeView1.Nodes.Add(Class(j), tvwChild, Class(j) & Space(1) & ClassName(j, i), ClassName(j, i))

      Next i

Next j

End Sub

‘管理学生成绩1

Dim myText As String

Dim myName As String

Dim ws As Worksheet

Dim myArray As Variant

Private Sub CommandButton1_Click()

Dim i As Integer

For i = 1 To TreeView1.Nodes.Count

    TreeView1.Nodes(i).Expanded = False

Next

Call 清除窗口

End Sub

Private Sub CommandButton2_Click()

Call 清除窗口

End Sub

Private Sub CommandButton3_Click()

Dim cel As Range, i As Integer

If 班级.Value = "" Then

MsgBox "班级不能为空", vbOKOnly, "提示信息"

Exit Sub

Else

End If

  For i = 1 To Worksheets.Count

    If Worksheets(i).Name = 班级.Value Then Exit For

  Next i


  If i > Worksheets.Count Then

        MsgBox "班级不存在", vbOKOnly, "提示信息"

        Exit Sub

  Exit Sub

  End If


'保存学生信息

Set ws = Worksheets(班级.Value)

p = ws.Range("b65536").End(xlUp).Row - 1

For Each cel In ws.Range("A2:A" & p + 1)

If cel.Text = 学号.Value Then

  For i = 1 To UBound(myArray)

    cel.Offset(0, i) = Me.Controls(myArray(i)).Value

  Next i

  GoTo HHHH

End If

Next

'添加新数据

p = ws.Range("B65536").End(xlUp).Row

For i = 1 To UBound(myArray) + 1

  Cells(p + 1, i) = Me.Controls(myArray(i - 1)).Value

Next

HHH:

Call 设置节点

For i = 1 To m

  If TreeView1.Nodes(i).Key = Class(i) Then

    TreeView1.Nodes(i).Expanded = True

    Exit For

  End If

Next i

HHHH:

End Sub

Private Sub CommandButton4_Click()

End

End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)

On Error Resume Next

Dim tem

Dim str As String

Dim cel As Range

myText = Node.Parent.Parent.Text & Space(1) & Node.Parent.Text

myName = Node.Text

Set ws = Worksheets(myText)

ws.Visible = xlSheetVisible

ws.Activate

'在工作表中查找此学生，并将查询到的学生信息显示在窗体上

p = ws.Range("B65536").End(xlUp).Row - 1

For Each cel In ws.Range("B2:B" & p + 1)

    If cel.Text = myName Then

      班级.Value = myText


      For i = 0 To UBound(myArray)

      Me.Controls(myArray(i)).Value = cel.Offset(0, i - 1)

      Next i

      Rows(cel.Row).Select

      Exit For

    Else

    Call 清除窗口

    End If

Next

Call 总分计算

For i = 1 To Worksheets.Count

If Worksheets(i).Name <> "首页" And Worksheets(i).Name <> Node.Key Then

    'Worksheets(i).Visible = False '保护除工作表“首页”外的所有工作表

End If

Next i

Worksheets(Node.Key).Visible = True

Worksheets(Node.Key).Activate

tem = Split(Node.Key, "班")

If UBound(tem) = 1 Then

str = tem(0)

班级.Value = str & "班"

Worksheets(班级.Value).Activate

End If

End Sub

Public Sub 清除窗口()

Dim i As Integer

班级.Value = ""

  For i = 0 To UBound(myArray)

      Me.Controls(myArray(i)).Value = ""

      Next i

End Sub

Public Sub 总分计算()

总分.Value = Val(数学.Value)

总分.Value = 总分.Value + Val(语文.Value)

总分.Value = 总分.Value + Val(英语.Value)

总分.Value = 总分.Value + Val(物理.Value)

总分.Value = 总分.Value + Val(化学.Value)

总分.Value = 总分.Value + Val(生物.Value)

总分.Value = 总分.Value + Val(体育.Value)

End Sub

Private Sub UserForm_Initialize()

'On Error Resume Next

myArray = Array("学号", "姓名", "性别", "数学", "语文", "英语", "物理", "化学", "生物", "体育", "总分")

Call 设置节点

End Sub

Public Sub 设置节点()

Dim i As Integer, j As Integer, k As Integer, p As Integer

Dim mystr As String

Call 年级班级

TreeView1.Nodes.Clear

'设置Treeview1 控件属性

TreeView1.LineStyle = tvwRootLines

TreeView1.LabelEdit = tvwManual

For j = 1 To m

Set nodx = TreeView1.Nodes.Add(, , Class(j), Class(j))

Next j

For j = 1 To m

      For i = 1 To n(j)

        Set nodx = TreeView1.Nodes.Add(Class(j), tvwChild, Class(j) & Space(1) & ClassName(j, i), ClassName(j, i))

      Next i

Next j

For j = 1 To m

  For i = 1 To n(j)

    '查某个班的学生数

    mystr = Class(j) & Space(1) & ClassName(j, i)

    Set ws = Worksheets(mystr)

    p = ws.Range("B65536").End(xlUp).Row - 1

    For k = 1 To p

      Set nodx = TreeView1.Nodes.Add(mystr, tvwChild, mystr & k, ws.Range("B" & k + 1))

      Next k

      Next i

      Next j

End Sub

Private Sub 体育_Change()

Call 总分计算

End Sub

Private Sub 化学_Change()

Call 总分计算

End Sub

Private Sub 总分_Change()

End Sub

Private Sub 总分_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Call 总分计算

End Sub

Private Sub 数学_Change()

Call 总分计算

End Sub

Private Sub 物理_Change()

Call 总分计算

End Sub

Private Sub 班级_Change()

End Sub

Private Sub 生物_Change()

Call 总分计算

End Sub

Private Sub 英语_Change()

Call 总分计算

End Sub

Private Sub 语文_Change()

Call 总分计算

End Sub

’成绩统计分析1

Dim myArray As Variant

Private Sub CommandButton1_Click()

Dim SheetExist As Boolean

Dim ws As Worksheet

Dim finalRow As Integer, i As Integer, k As Integer

Dim myCondition As String

Dim cnn As ADODB.Connection

Dim rs As ADODB.Recordset

'判断工作簿中是否存在"统计分析结果"工作表

SheetExist = False

For Each ws In Worksheets

If ws.Name = "统计分析结果" Then

  SheetExist = True: Exit For

End If

Next

If SheetExist = False Then

Worksheets.Add after:=Worksheets(Worksheets.Count)

ActiveSheet.Name = "统计分析结果"

End If

Set ws = Worksheets("统计分析结果")

ws.Visible = xlSheetVisible

ws.Activate

ws.Cells.Clear

myCondition = "WHERE " & 学科.Value

If 比较符.Value = "between" Then

myCondition = myCondition & " between " & Val(条件1.Value) & " and " & Val(条件2.Value)

Else

myCondition = myCondition & 比较符.Value & Val(条件1.Value)

End If

'建立与当前工作簿的连接

Set cnn = New ADODB.Connection

With cnn

.Provider = "microsoft.jet.oledb.4.0"

.ConnectionString = "extended properties=excel 8.0;" _

& "data source=" & ThisWorkbook.FullName

.Open

End With

'输入标题

ws.Range("A1:E1") = Array(" 班级", "学号", "姓名", "性别", 学科.Value)

'根据选择的统计分析要求，查询数据并复制到工作表"统计分析结果"中

If 选择班级.Value = "全年级" Then

For i = 1 To Worksheets.Count

  If Worksheets(i).Name = "首页" Or Worksheets(i).Name = "班级管理" Or Worksheets(i).Name = "统计分析结果" Or InStr(Worksheets(i).Name, 选择年级.Value) = 0 Then GoTo myNext

  mysql = "select 学号,姓名,性别," & 学科.Value & " from [" & Worksheets(i).Name & "$] " & myCondition & " order by " & 学科.Value & " DESC"

  Set rs = New ADODB.Recordset

  rs.Open mysql, cnn, adOpenKeyset, adLockOptimistic

  finalRow = ws.Range("A65536").End(xlUp).Row

  If rs.RecordCount > 0 Then

  For k = 1 To rs.RecordCount

    ws.Range("A" & k + finalRow) = Worksheets(i).Name

  Next k


  '复制查询到的数据

  ws.Range("B" & finalRow + 1).CopyFromRecordset rs

  End If

myNext:

  Next i

  Else

  mysql = "SELECT 学号,姓名,性别," & 学科.Value & " FROM [" & 选择年级.Value & Space(1) & 选择班级.Value & "$] " & myCondition & " order by " & 学科.Value & " DESC"

  Set rs = New ADODB.Recordset

  rs.Open mysql, cnn, adOpenKeyset, adLockOptimistic


  finalRow = ws.Range("A65536").End(xlUp).Row

  If rs.RecordCount > 0 Then

    ws.Range("A" & finalRow + 1) = 选择班级.Value

    ws.Range("B" & finalRow + 1).CopyFromRecordset rs

    Else

    MsgBox "没有查到符合条件的学生!", vbInformation, "没有记录"

    End If

  End If

  Application.ScreenUpdating = True


End Sub

Private Sub CommandButton2_Click()

End

End Sub

Private Sub Frame1_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()

Dim j As Integer

Set wb = ThisWorkbook

Call 年级班级

For j = 1 To m

  选择年级.AddItem Class(j)

Next j

选择年级.ListIndex = 0

'为查询项目复合框设置项目

myArray = Array("数学", "语文", "英语", "物理", "化学", "生物", "体育", "总分")

For j = 0 To UBound(myArray)

学科.AddItem myArray(j)

Next j

学科.ListIndex = 0

'为查询条件复合框设置项目

With 比较符

.AddItem "="

.AddItem ">"

.AddItem "<"

.AddItem "between"

End With

比较符.ListIndex = 0

End Sub

Private Sub 学科_Change()

End Sub

Private Sub 学科_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

Private Sub 比较符_Change()

If 比较符.Value = "between" Then

与.Visible = True: 条件2.Visible = True: 条件1.Width = 72

Else

与.Visible = False: 条件2.Visible = False: 条件1.Width = 90

End If

条件1.SetFocus

End Sub

Private Sub 比较符_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

Private Sub 选择年级_Change()

Dim i As Integer

'为选择班级复合框设置项目

选择班级.Clear

For i = 1 To n(选择年级.ListIndex + 1)

选择班级.AddItem ClassName(选择年级.ListIndex + 1, i)

Next i

选择班级.AddItem "全年级"

选择班级.ListIndex = 0

End Sub

Private Sub 选择年级_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

Private Sub 选择班级_Change()

End Sub

Private Sub 选择班级_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

‘查询学生成绩1

Dim myArray

Dim myRow As Integer

Dim ws As Worksheet

Private Sub Label8_Click()

End Sub

Private Sub 查询_Click()

On Error Resume Next

Dim myColumn As Integer

Set ws = Worksheets(查询年级.Value & Space(1) & 查询班级.Value)

ws.Visible = xlSheetVisible

ws.Activate

If 查询.Caption = "查询" Then

myRow = 2

Rows(myRow).Select

End If

myColumn = 查询项目.ListIndex + 4

For i = myRow To ws.Range("A65536").End(xlUp).Row

  If 查询条件.Value = "大于" Then

    If Val(Cells(i, myColumn).Value) > Val(条件值.Value) Then

  Call 查询显示(Cells(i, myColumn), myColumn)

  myRow = Cells(i, myColumn).Row + 1

  Rows(myRow - 1).Select

  查询.Caption = "查找下一个"

  Exit Sub

  End If


  ElseIf 查询条件.Value = "等于" Then

    If Val(Cells(i, myColumn).Value) = Val(条件值.Value) Then

  Call 查询显示(Cells(i, myColumn), myColumn)

  myRow = Cells(i, myColumn).Row + 1

  Rows(myRow - 1).Select

  查询.Caption = "查找下一个"

  Exit Sub

  End If


  ElseIf 查询条件.Value = "小于" Then

    If Val(Cells(i, myColumn).Value) < Val(条件值.Value) Then

  Call 查询显示(Cells(i, myColumn), myColumn)

  myRow = Cells(i, myColumn).Row + 1

  Rows(myRow - 1).Select

  查询.Caption = "查找下一个"

  Exit Sub

  End If

  End If

Next i

MsgBox "没有查询的结果！", vbExclamation, "无查询结果"

查询.Caption = "查询"

End Sub

Public Sub 查询显示(mycel As Range, myCol As Integer)

姓名.Value = Cells(mycel.Row, 2)

性别.Value = Cells(mycel.Row, 3)

Label8.Caption = 查询项目.Value & "分数:"

项目结果.Value = Cells(mycel.Row, myCol)

End Sub

Private Sub CommandButton2_Click()

End

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()

Dim j As Integer

Call 年级班级

For j = 1 To m

  查询年级.AddItem Class(j)

Next j

查询年级.ListIndex = 0

'为查询项目复合框设置项目

myArray = Array("数学", "语文", "英语", "物理", "化学", "生物", "体育", "总分")

For j = 0 To UBound(myArray)

查询项目.AddItem myArray(j)

Next j

查询项目.ListIndex = 0

'为查询条件复合框设置项目

With 查询条件

.AddItem "大于"

.AddItem "等于"

.AddItem "小于"

End With

查询条件.ListIndex = 0

End Sub

Private Sub 查询年级_Change()

Dim i As Integer

'为查询班级复合框设置项目

查询班级.Clear

For i = 1 To n(查询年级.ListIndex + 1)

查询班级.AddItem ClassName(查询年级.ListIndex + 1, i)

Next i

查询班级.ListIndex = 0

End Sub

Private Sub 查询年级_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

Private Sub 查询条件_Change()

End Sub

Private Sub 查询条件_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

Private Sub 查询班级_Change()

End Sub

Private Sub 查询班级_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

Private Sub 查询项目_Change()

End Sub

Private Sub 查询项目_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

End Sub

最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
  • 人面猴
    序言：七十年代末，一起剥皮案震惊了整个滨河市，随后出现的几起案子，更是在滨河造成了极大的恐慌，老刑警刘岩，带你破解...
    沈念sama阅读 202,607评论 5赞 476
  • 死咒
    序言：滨河连续发生了三起死亡事件，死亡现场离奇诡异，居然都是意外死亡，警方通过查阅死者的电脑和手机，发现死者居然都...
    沈念sama阅读 85,047评论 2赞 379
  • 救了他两次的神仙让他今天三更去死
    文/潘晓璐 我一进店门，熙熙楼的掌柜王于贵愁眉苦脸地迎上来，“玉大人，你说我怎么就摊上这事。” “怎么了？”我有些...
    开封第一讲书人阅读 149,496评论 0赞 335
  • 道士缉凶录：失踪的卖姜人
    文/不坏的土叔 我叫张陵，是天一观的道长。 经常有香客问我，道长，这世上最难降的妖魔是什么？ 我笑而不...
    开封第一讲书人阅读 54,405评论 1赞 273
  • 港岛之恋（遗憾婚礼）
    正文 为了忘掉前任，我火速办了婚礼，结果婚礼上，老公的妹妹穿的比我还像新娘。我一直安慰自己，他们只是感情好，可当我...
    茶点故事阅读 63,400评论 5赞 364
  • 恶毒庶女顶嫁案：这布局不是一般人想出来的
    文/花漫 我一把揭开白布。 她就那样静静地躺着，像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上，一...
    开封第一讲书人阅读 48,479评论 1赞 281
  • 城市分裂传说
    那天，我揣着相机与录音，去河边找鬼。 笑死，一个胖子当着我的面吹牛，可吹牛的内容都是我干的。 我是一名探鬼主播，决...
    沈念sama阅读 37,883评论 3赞 395
  • 双鸳鸯连环套：你想象不到人心有多黑
    文/苍兰香墨 我猛地睁开眼，长吁一口气：“原来是场噩梦啊……” “哼！你这毒妇竟也来了？” 一声冷哼从身侧响起，我...
    开封第一讲书人阅读 36,535评论 0赞 256
  • 万荣杀人案实录
    序言：老挝万荣一对情侣失踪，失踪者是张志新（化名）和其女友刘颖，没想到半个月后，有当地人在树林里发现了一具尸体，经...
    沈念sama阅读 40,743评论 1赞 295
  • 护林员之死
    正文 独居荒郊野岭守林人离奇死亡，尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,544评论 2赞 319
  • 白月光启示录
    正文 我和宋清朗相恋三年，在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,612评论 1赞 329
  • 活死人
    序言：一个原本活蹦乱跳的男人离奇死亡，死状恐怖，灵堂内的尸体忽然破棺而出，到底是诈尸还是另有隐情，我是刑警宁泽，带...
    沈念sama阅读 33,309评论 4赞 318
  • 日本核电站爆炸内幕
    正文 年R本政府宣布，位于F岛的核电站，受9级特大地震影响，放射性物质发生泄漏。R本人自食恶果不足惜，却给世界环境...
    茶点故事阅读 38,881评论 3赞 306
  • 男人毒药：我在死后第九天来索命
    文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹，春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,891评论 0赞 19
  • 一桩弑父案，背后竟有这般阴谋
    文/苍兰香墨 我抬头看了看天上的太阳。三九已至，却和暖如春，着一层夹袄步出监牢的瞬间，已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,136评论 1赞 259
  • 情欲美人皮
    我被黑心中介骗来泰国打工， 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留，地道东北人。 一个月前我还...
    沈念sama阅读 42,783评论 2赞 349
  • 代替公主和亲
    正文 我出身青楼，却偏偏与公主长得像，于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子，可洞房花烛夜当晚...
    茶点故事阅读 42,316评论 2赞 342

推荐阅读更多精彩内容

  • Excel VBA命令大全
    本例为设置密码窗口 (1) If Application.InputBox(“请输入密码：”) = 1234 Th...
    浮浮尘尘阅读 13,573评论 1赞 20
  • rljs
    rljs by sennchi Timeline of History Part One The Cognitiv...
    sennchi阅读 7,279评论 0赞 10
  • vba
    可以通过在属性窗口设置名称来给对象重新命名，名字可以由字母、汉字（2字符）、数字以及下划线组成，但必须以字母或汉字...
    重头再来0706阅读 2,157评论 0赞 1
  • 亲爱的她们｜叶怡兰：以享乐之名过简单的日子
    至今还很清楚地记得，第一次读到叶怡兰，是在仲夏的一个午后，在学校的图书馆，在那排长长的书架上，叶怡兰的两本书一下子...
    小渔的读书旅行阅读 600评论 0赞 0
  • 装死躲熊
    Once upon a time, two friends were traveling together in ...
    硅码老舅阅读 161评论 0赞 0