VBA與excel實現(xiàn)學(xué)生管理系統(tǒng) 代碼

適合學(xué)習(xí)者或具體有中級編程水平的朋友學(xué)習(xí)?

完整代碼連接：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)是向左查詢，直到最后一個非空數(shù)據(jù)下截止，并將其數(shù)值附上。

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 管理學(xué)生名單()

Call 管理1.Show

End Sub

Sub 管理學(xué)生成績()

管理學(xué)生成績1.Show

End Sub

Sub 查詢學(xué)生成績()

查詢學(xué)生成績1.Show

End Sub

Sub 成績統(tǒng)計分析()

成績統(tǒng)計分析1.Show

End Sub

Sub 打印成績單()

Print1.Show

End Sub

Sub 班級管理()

Worksheets("班級管理").Visible = True? '顯示工作表"班級管理"

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

End Sub

‘5個窗體

‘管理1 ?管理學(xué)生成績1 成績統(tǒng)計1 查詢學(xué)生成績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

'以下功能是發(fā)現(xiàn)班級不在就建立所有不在的班級

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說明沒找到對應(yīng)班級，所以要建立班級

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

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


? ? Range("A1:k1").Select

? ? Selection = Array("學(xué)號", "姓名 ", "性別 ", "數(shù)學(xué) ", "語文 ", "英語 ", "物理 ", "化學(xué) ", "生物", "體育", "總分")

? ? Selection.HorizontalAlignment = xlCenter '標題文字居中

? ? Columns("A:A").NumberFormatLocal = "@" 'A列數(shù)據(jù)為文本

? ? 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

‘管理學(xué)生成績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


'保存學(xué)生信息

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 = 學(xué)號.Value Then

? For i = 1 To UBound(myArray)

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

? Next i

? GoTo HHHH

End If

Next

'添加新數(shù)據(jù)

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 設(shè)置節(jié)點

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

'在工作表中查找此學(xué)生，并將查詢到的學(xué)生信息顯示在窗體上

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(數(shù)學(xué).Value)

總分.Value = 總分.Value + Val(語文.Value)

總分.Value = 總分.Value + Val(英語.Value)

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

總分.Value = 總分.Value + Val(化學(xué).Value)

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

總分.Value = 總分.Value + Val(體育.Value)

End Sub

Private Sub UserForm_Initialize()

'On Error Resume Next

myArray = Array("學(xué)號", "姓名", "性別", "數(shù)學(xué)", "語文", "英語", "物理", "化學(xué)", "生物", "體育", "總分")

Call 設(shè)置節(jié)點

End Sub

Public Sub 設(shè)置節(jié)點()

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

Dim mystr As String

Call 年級班級

TreeView1.Nodes.Clear

'設(shè)置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)

? ? '查某個班的學(xué)生數(shù)

? ? 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 化學(xué)_Change()

Call 總分計算

End Sub

Private Sub 總分_Change()

End Sub

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

Call 總分計算

End Sub

Private Sub 數(shù)學(xué)_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

’成績統(tǒng)計分析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

'判斷工作簿中是否存在"統(tǒng)計分析結(jié)果"工作表

SheetExist = False

For Each ws In Worksheets

If ws.Name = "統(tǒng)計分析結(jié)果" Then

? SheetExist = True: Exit For

End If

Next

If SheetExist = False Then

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

ActiveSheet.Name = "統(tǒng)計分析結(jié)果"

End If

Set ws = Worksheets("統(tǒng)計分析結(jié)果")

ws.Visible = xlSheetVisible

ws.Activate

ws.Cells.Clear

myCondition = "WHERE " & 學(xué)科.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(" 班級", "學(xué)號", "姓名", "性別", 學(xué)科.Value)

'根據(jù)選擇的統(tǒng)計分析要求，查詢數(shù)據(jù)并復(fù)制到工作表"統(tǒng)計分析結(jié)果"中

If 選擇班級.Value = "全年級" Then

For i = 1 To Worksheets.Count

? If Worksheets(i).Name = "首頁" Or Worksheets(i).Name = "班級管理" Or Worksheets(i).Name = "統(tǒng)計分析結(jié)果" Or InStr(Worksheets(i).Name, 選擇年級.Value) = 0 Then GoTo myNext

? mysql = "select 學(xué)號,姓名,性別," & 學(xué)科.Value & " from [" & Worksheets(i).Name & "$] " & myCondition & " order by " & 學(xué)科.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


? '復(fù)制查詢到的數(shù)據(jù)

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

? End If

myNext:

? Next i

? Else

? mysql = "SELECT 學(xué)號,姓名,性別," & 學(xué)科.Value & " FROM [" & 選擇年級.Value & Space(1) & 選擇班級.Value & "$] " & myCondition & " order by " & 學(xué)科.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 "沒有查到符合條件的學(xué)生!", 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

'為查詢項目復(fù)合框設(shè)置項目

myArray = Array("數(shù)學(xué)", "語文", "英語", "物理", "化學(xué)", "生物", "體育", "總分")

For j = 0 To UBound(myArray)

學(xué)科.AddItem myArray(j)

Next j

學(xué)科.ListIndex = 0

'為查詢條件復(fù)合框設(shè)置項目

With 比較符

.AddItem "="

.AddItem ">"

.AddItem "<"

.AddItem "between"

End With

比較符.ListIndex = 0

End Sub

Private Sub 學(xué)科_Change()

End Sub

Private Sub 學(xué)科_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

'為選擇班級復(fù)合框設(shè)置項目

選擇班級.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

‘查詢學(xué)生成績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 "沒有查詢的結(jié)果！", vbExclamation, "無查詢結(jié)果"

查詢.Caption = "查詢"

End Sub

Public Sub 查詢顯示(mycel As Range, myCol As Integer)

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

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

Label8.Caption = 查詢項目.Value & "分數(shù):"

項目結(jié)果.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

'為查詢項目復(fù)合框設(shè)置項目

myArray = Array("數(shù)學(xué)", "語文", "英語", "物理", "化學(xué)", "生物", "體育", "總分")

For j = 0 To UBound(myArray)

查詢項目.AddItem myArray(j)

Next j

查詢項目.ListIndex = 0

'為查詢條件復(fù)合框設(shè)置項目

With 查詢條件

.AddItem "大于"

.AddItem "等于"

.AddItem "小于"

End With

查詢條件.ListIndex = 0

End Sub

Private Sub 查詢年級_Change()

Dim i As Integer

'為查詢班級復(fù)合框設(shè)置項目

查詢班級.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

最后編輯于 ：
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請聯(lián)系作者
【社區(qū)內(nèi)容提示】社區(qū)部分內(nèi)容疑似由AI輔助生成，瀏覽時請結(jié)合常識與多方信息審慎甄別。
平臺聲明：文章內(nèi)容（如有圖片或視頻亦包括在內(nèi)）由作者上傳并發(fā)布，文章內(nèi)容僅代表作者本人觀點，簡書系信息發(fā)布平臺，僅提供信息存儲服務(wù)。

相關(guān)閱讀更多精彩內(nèi)容

  • 本例為設(shè)置密碼窗口 (1) If Application.InputBox(“請輸入密碼：”) = 1234 Th...
    浮浮塵塵閱讀 14,639評論 1贊 20
  • rljs by sennchi Timeline of History Part One The Cognitiv...
    sennchi閱讀 7,817評論 0贊 10
  • 可以通過在屬性窗口設(shè)置名稱來給對象重新命名，名字可以由字母、漢字（2字符）、數(shù)字以及下劃線組成，但必須以字母或漢字...
    重頭再來0706閱讀 2,326評論 0贊 1
  • 至今還很清楚地記得，第一次讀到葉怡蘭，是在仲夏的一個午后，在學(xué)校的圖書館，在那排長長的書架上，葉怡蘭的兩本書一下子...
    小漁的讀書旅行閱讀 806評論 0贊 0
  • Once upon a time, two friends were traveling together in ...
    硅碼老舅閱讀 191評論 0贊 0

友情鏈接更多精彩內(nèi)容