Access數(shù)據(jù)庫(kù)VBA編程實(shí)例通用成績(jī)處理系統(tǒng)

1、Access數(shù)據(jù)庫(kù) VBA 編程實(shí)例通用成績(jī)處理系統(tǒng)詔安一中信息技術(shù)組吳瑤民同學(xué)們通過(guò)學(xué)習(xí)高中選修課4數(shù)據(jù)庫(kù)管理技術(shù)第四章“開發(fā)數(shù)據(jù)庫(kù)應(yīng)用系統(tǒng)”，已初步學(xué)會(huì)了簡(jiǎn)單應(yīng)用系統(tǒng)的設(shè)計(jì)，為了讓同學(xué)們能進(jìn)一步提升開發(fā)能力，以學(xué)生熟知的成績(jī)統(tǒng)計(jì)為實(shí)例，結(jié)合 VBA 編寫通用成績(jī)處理系統(tǒng)。一、系統(tǒng)總體分析與設(shè)計(jì)成績(jī)錄入采用EXCEL 電子表格模板方式，各班以電子表格形式上繳年段，由年段匯總后導(dǎo)入通用成績(jī)處理系統(tǒng)，然后由系統(tǒng)進(jìn)行計(jì)算總分、排名次、質(zhì)量分析后，通過(guò)導(dǎo)出功能導(dǎo)出EXCEL 表格形式并打印出統(tǒng)計(jì)結(jié)果。錄入成績(jī)與打印成績(jī)都在教師悉熟的EXCEL電子表格進(jìn)行，方便教師操作，數(shù)據(jù)的統(tǒng)計(jì)與分析由系統(tǒng)自動(dòng)完成

2、，提高工作效率。將上述模塊設(shè)計(jì)圖示化后我們便可以得到所示的系統(tǒng)功能模塊圖：導(dǎo)入成績(jī)（ EXCEL 格式）導(dǎo)入信息瀏覽計(jì)算三率統(tǒng)計(jì)分析班級(jí)排名通用年段排名三率瀏覽成導(dǎo)出學(xué)生站隊(duì)表績(jī)返回學(xué)生站隊(duì)瀏覽處理導(dǎo)出質(zhì)量分析導(dǎo)出結(jié)果（ EXCEL 格式）系統(tǒng)使用幫助返回退出系統(tǒng)二、數(shù)據(jù)庫(kù)分析與設(shè)計(jì)1數(shù)據(jù)庫(kù)數(shù)據(jù)結(jié)構(gòu)分析通過(guò)對(duì)成績(jī)統(tǒng)計(jì)過(guò)程分析及數(shù)據(jù)要求，創(chuàng)建該管理系統(tǒng)數(shù)據(jù)庫(kù)，名為“通用成績(jī)管理系統(tǒng) mdb ”，主要包含的數(shù)據(jù)表有“學(xué)生成績(jī)”、“質(zhì)量分析”兩個(gè)表?！皩W(xué)生成績(jī)”為EXCEL格式的“學(xué)生成績(jī)”通過(guò)導(dǎo)入模塊生成，EXCEL 格式的“學(xué)生成績(jī)”格式如下：“質(zhì)量分析”表結(jié)構(gòu)設(shè)計(jì)如下表：字段名稱數(shù)據(jù)類型字段大

3、小小數(shù)位班級(jí)文本2科目文本8與考人數(shù)數(shù)字長(zhǎng)整形自動(dòng)及格人數(shù)數(shù)字長(zhǎng)整形自動(dòng)高分人數(shù)數(shù)字長(zhǎng)整形自動(dòng)平均分?jǐn)?shù)字單精度2及格率數(shù)字單精度4高分率數(shù)字單精度42、窗體的設(shè)計(jì)與實(shí)現(xiàn)窗體是 Access 2003 數(shù)據(jù)庫(kù)系統(tǒng)的一個(gè)重要對(duì)象。前面介紹的數(shù)據(jù)導(dǎo)入、瀏覽記錄、質(zhì)量分析、顯示查詢結(jié)果、導(dǎo)出數(shù)據(jù)等都是在“數(shù)據(jù)表”視圖中所進(jìn)行的操作。（ 1）通用成績(jī)處理系統(tǒng)窗體：圖一該窗體及命令按鈕VBA 代碼：Private Sub Form_Load()MsgBox (" 使用前先進(jìn)入“使用幫助”，花幾分鐘閱讀一下使用說(shuō)明，會(huì)使你的工作事半功倍 !")End SubPrivate Sub 命令

4、0_Click()On Error GoTo errDim db As DatabaseSet db = CurrentDb()If db.TableDefs(i).Name = " 學(xué)生成績(jī) " ThenDoCmd.DeleteObject acTable, " 學(xué)生成績(jī) "End IfNext iSet db = NothingMsgBox (" 請(qǐng)將要導(dǎo)入的文件置于“成績(jī)統(tǒng)計(jì)”文件夾中，文件名必須是“學(xué)生成績(jī)”")DoCmd.TransferSpreadsheet acImport, 8, " 學(xué)生成績(jī)學(xué)生成績(jī) .xl

5、s",TrueMsgBox (" 導(dǎo)入完成 !")Exit Suberr:MsgBox (" 找不到文件或文件格式不對(duì)")End SubPrivate Sub 命令 11_Click()DoCmd.OpenTable " 學(xué)生成績(jī) "End SubPrivate Sub 命令 12_Click()MsgBox (" 提示： 00 表示年段， 01 表示一班， 02 表示二班 .")DoCmd.OpenTable " 質(zhì)量分析 "End SubPrivate Sub 命令 13_Clic

6、k()DoCmd.OpenQuery "temp"End SubPrivate Sub 命令 15_Click()功能說(shuō)明 .doc"End SubPrivate Sub 命令 22_Click()DoCmd.Quit acQuitSaveAllEnd SubPrivate Sub 命令 6_Click()DoCmd.OpenForm " 質(zhì)量分析 "End SubPrivate Sub 命令 7_Click()DoCmd.OpenForm " 導(dǎo)出結(jié)果 "End Sub（ 2）質(zhì)量分析窗體各命令按鈕VBA代碼：Privat

7、e Sub命令 10_Click()Dim kmzf(15) As DoubleDim kmmc(15) As StringFor i = 1 To 11kmzf(i) = Val(Me.Controls("txtzf" & i).Value)Nextkmmc(1) = "數(shù)學(xué) "kmmc(2) = "語(yǔ)文 "kmmc(3) = "英語(yǔ) "kmmc(4) = "物理 "kmmc(5) = "化學(xué) "kmmc(6) = "地理 "kmmc(7) =

8、"政治 "kmmc(8) = "歷史 "kmmc(9) = "生物 "kmmc(10) = "文綜 "kmmc(11) = "理綜 "Dim k As Stringtt = Falsek = ""'Dim db As DAO.Database '聲明數(shù)據(jù)庫(kù)對(duì)象變量Set db = CurrentDb()db.Execute "DELETE * FROM質(zhì)量分析 ;"For i = 1 To 11If Me.Controls("ch

9、eck" & i) <> 0 ThenCall統(tǒng)計(jì) (kmmc(i), kmzf(i), "00") '算年段三率For j = Val(TXTbjks.Value) To Val(TXTbjks.Value) + bjzs - 1If j < 10 Thenk = "0" & CStr(j)Call統(tǒng)計(jì) (kmmc(i), kmzf(i), k) '算班級(jí)三率Elsek = CStr(j)Call統(tǒng)計(jì) (kmmc(i), kmzf(i), k)End IfNext jEnd IfNext iI

10、f tt = False ThenMsgBox (" 統(tǒng)計(jì)完畢，請(qǐng)返回主菜單導(dǎo)出結(jié)果打印")End IfEnd SubPrivate Sub命令 97_Click()Call查詢End SubPrivate Sub命令 100_Click()DoCmd.CloseEnd SubPrivate Sub命令 111_Click()Dim kk As StringCall計(jì)算總分For i = Val(TXTbjks.Value) To Val(TXTbjks.Value) + Val(txtbjzs.Value) - 1Debug.Print iIf i < 10 The

11、nkk = """0" & CStr(i) & "*"""Elsekk = """" & CStr(i) & "*""" End IfDebug.Print kkCall RangBerechnen_bj("學(xué)生成績(jī) ", kk, "總分 ")Next iMsgBox ("處理完畢！ ")End SubPrivate Sub命令 98_Click

12、()tt = True'Call計(jì)算總分Call RangBerechnen("學(xué)生成績(jī) ", "總分 ") '年段排名Call查詢If tt ThenMsgBox ("統(tǒng)計(jì)完畢，請(qǐng)返回主菜單導(dǎo)出結(jié)果打印")End IfEnd Sub（ 3）導(dǎo)出結(jié)果窗體各命令按鈕VBA代碼：Private Sub命令 0_Click()學(xué)生站隊(duì)表 .xls"MsgBox "導(dǎo)出完畢 ! 結(jié)果為“成績(jī)統(tǒng)計(jì)學(xué)生站隊(duì)表 .xls ” "End SubPrivate Sub命令 1_Click()DoCmd.Ou

13、tputTo acOutputTable, "質(zhì)量分析質(zhì)量分析 .xls"MsgBox "導(dǎo)出完畢 ! 結(jié)果為“成績(jī)統(tǒng)計(jì)質(zhì)量分析 .xls”"End SubPrivate Sub命令 3_Click()DoCmd.CloseEnd Sub（ 4）通用模塊代碼Public tt As BooleanPublic i As IntegerPublic j As IntegerPublic str As StringPublic bjzs As IntegerPublic kmzf(15) '存放各科總分Public kmmc(15) '存放科

14、目名稱Sub 統(tǒng)計(jì) (km As String, kmzf As Double, jj As String)Dim sum As LongDim intI As LongDim avg As SingleDim gfli As SingleDim jgli As SingleDim strsql As StringDim db As DAO.Database '聲明數(shù)據(jù)庫(kù)對(duì)象變量Dim recName As DAO.Recordset '聲明記錄集對(duì)象變量Dim strName As DAO.Field '聲明字段對(duì)象變量On Error GoTo wrongSet d

15、b = CurrentDb() '指定數(shù)據(jù)庫(kù)為當(dāng)前數(shù)據(jù)庫(kù)If jj = "00" ThenSet recName = db.OpenRecordset("學(xué)生成績(jī) ") '計(jì)算年段ElseSet recName = db.OpenRecordset("select * from學(xué)生成績(jī) where班號(hào) like " & """"& jj & "*" & """") '計(jì)算班級(jí)End

16、 IfSet strName = recName.Fields(km) '指定記錄集“科目”字段' 計(jì)算三率jgrs = 0 '及格人數(shù)sum = 0 '總分gfrs = 0 '高分人數(shù)intI = 0 '總?cè)藬?shù)Do Until recName.EOFsum = sum + IIf(IsNull(strName), 0, strName) 'If strName >= kmzf * 0.6 Thenjgrs = jgrs + 1 '及格人數(shù)End IfIf strName >= 0.8 * kmzf Thengfrs

17、= gfrs + 1'高分的人數(shù)End IfintI = intI + 1 '總?cè)藬?shù)recName.MoveNext '讀取記錄集的下一行記錄Loopavg = sum / intI '平均分gfli = gfrs / intI '高分率jgli = jgrs / intI '及格率將“科目”字段讀入數(shù)組' 寫入“質(zhì)量分析”表Set recName = db.OpenRecordset("質(zhì)量分析 ") '將“”表讀入記錄集recName.AddNewrecName.Fields(0) = jjrecName.

18、Fields(1) = kmrecName.Fields(2) = intIrecName.Fields(3) = jgrsrecName.Fields(4) = gfrsrecName.Fields(5) = avgrecName.Fields(6) = jglirecName.Fields(7) = gflirecName.UpdateExit Subwrong:MsgBox ("找不到科目成績(jī)或者班級(jí)總數(shù)設(shè)置不對(duì)! 請(qǐng)檢查并重新設(shè)置i = 11: j = 18000: tt = TrueEnd Sub' 生成 temp 查詢Public Sub查詢 ()")D

19、im db As DAO.Database '聲明數(shù)據(jù)庫(kù)對(duì)象變量Dim qry As DAO.QueryDefSet db = CurrentDb()If db.QueryDefs(i).Name = "temp" ThenDoCmd.DeleteObject acQuery, "temp"End IfNext iSet qry = db.CreateQueryDef("temp")qry.SQL = "SELECT * FROM學(xué)生成績(jī)ORDER BY 總分 DESC"Set db = NothingEn

20、d SubPublic Sub計(jì)算總分 ()Dim db As DAO.Database '聲明數(shù)據(jù)庫(kù)對(duì)象變量Dim recName As DAO.Recordset '聲明記錄集對(duì)象變量Dim strName As DAO.Field '聲明字段對(duì)象變量kmmc(1) = "數(shù)學(xué) "kmmc(2) = "語(yǔ)文 "kmmc(3) = "英語(yǔ) "kmmc(4) = "物理 "kmmc(5) = "化學(xué) "kmmc(6) = "地理 "kmmc(7) =

21、"政治 "kmmc(8) = "歷史 "kmmc(9) = "生物 "kmmc(10) = "文綜 "kmmc(11) = "理綜 "Set db = CurrentDb() '指定數(shù)據(jù)庫(kù)為當(dāng)前數(shù)據(jù)庫(kù)Set recName = db.OpenRecordset("學(xué)生成績(jī) ") '將“”表讀入記錄集On Error GoTo errDo Until recName.EOFsum = 0For i = 1 To 11If Form_質(zhì)量分析 .Controls(

22、"check" & i) <> 0 Thensum=sum+IIf(IsNull(recName.Fields(kmmc(i),0,recName.Fields(kmmc(i)End IfNext irecName.EditrecName.Fields("總分 ") = sumrecName.UpdaterecName.MoveNextLoopExit Suberr:MsgBox "找不到成績(jī) ! 請(qǐng)重新設(shè)置科目 "tt = FalseEnd Sub' 計(jì)算名次Public Function RangBer

23、echnen(TableName As String, LeistungFeld As String) As Boolean On Error GoTo Err_RangDim db As DAO.DatabaseDim rst As DAO.RecordsetDim iRang As LongDim iLeistung As IntegerDim iGleicherRang As IntegerSet db = CurrentDbSetrst= db.OpenRecordset("SELECT* FROM" & TableName & " ORD

24、ERBY " & LeistungFeld& " DESC", dbOpenDynaset) iRang = 1iLeistung = .Fields(LeistungFeld).Edit! 年名 = iRang.Update.MoveNextIf .EOF Then Exit Do iGleicherRang = 0Do While (.Fields(LeistungFeld) = iLeistung).Edit!年名 = iRang.UpdateiGleicherRang = iGleicherRang + 1.MoveNextIf .EOF

25、Then Exit DoLoopiRang = iRang + 1 + iGleicherRangLoop.CloseEnd WithRangBerechnen = TrueSet db = NothingSet rst = NothingExit_Rang:Exit FunctionErr_Rang:RangBerechnen = FalseResume Exit_RangEnd Function' 計(jì)算班級(jí)名次Public Function RangBerechnen_bj(TableName As String, tiaoj As String, LeistungFeld As String) As BooleanOn Error GoTo Err_