Access数据库VBA编程实例通用成绩处理系统
Access数据库VBA编程实例——通用成绩处理系统
诏安一中信息技术组吴瑶民
同学们通过学习高中选修课4《数据库管理技术》第四章“开发数据库应用系统”，已初步学会了简单应用系统的设计，为了让同学们能进一步提升开发能力，以学生熟知的成绩统计为实例，结合VBA编写通用成绩处理系统。
一、系统总体分析与设计
成绩录入采用EXCEL电子表格模板方式，各班以电子表格形式上缴年段，由年段汇总后导入通用成绩处理系统，然后由系统进行计算总分、排名次、质量分析后，通过导出功能导出EXCEL表格形式并打印出统计结果。录入成绩与打印成绩都在教师悉熟的EXCEL电子表格进行，方便教师操作，数据的统计与分析由系统自动完成，提高工作效率。
将上述模块设计图示化后我们便可以得到所示的系统功能模块图：
二、数据库分析与设计
1．数据库数据结构分析
通过对成绩统计过程分析及数据要求，创建该管理系统数据库，名为“通用成绩管理系统．mdb”，主要包含的数据表有“学生成绩”、“质量分析”两个表。“学生成绩”为EXCEL 格式的“学生成绩”通过导入模块生成，EXCEL格式的“学生成绩”格式如下：
通用成绩处理系统导入成绩（EXCEL格式）
导入信息浏览
统计分析
三率浏览
学生站队浏览
退出系统
导出学生站队表
返回
导出质量分析导出结果（EXCEL格式）
使用帮助
计算三率
返回
班级排名
年段排名
“质量分析”表结构设计如下表：
字段名称数据类型字段大小小数位
班级文本 2
科目文本8
与考人数数字长整形自动
及格人数数字长整形自动
高分人数数字长整形自动
平均分数字单精度 2
及格率数字单精度 4
高分率数字单精度 4
2、窗体的设计与实现
窗体是Access 2003数据库系统的一个重要对象。前面介绍的数据导入、浏览记录、质量分析、显示查询结果、导出数据等都是在“数据表”视图中所进行的操作。
（1）通用成绩处理系统窗体：
图一
该窗体及命令按钮VBA代码：
Private Sub Form_Load()
MsgBox ("使用前先进入“使用帮助”，花几分钟阅读一下使用说明，会使你的工作事半功倍!")
End Sub
Private Sub 命令0_Click()
On Error GoTo err
Dim db As Database
Set db = CurrentDb()
For i = 0 To db.TableDefs.Count - 1
If db.TableDefs(i).Name = "学生成绩" Then
DoCmd.DeleteObject acTable, "学生成绩"
End If
Next i
Set db = Nothing
MsgBox ("请将要导入的文件置于“成绩统计”文件夹中，文件名必须是“学生成绩”") DoCmd.TransferSpreadsheet acImport, 8, "学生成绩", CurrentProject.Path & "\学生成绩.xls", True
MsgBox ("导入完成!")
Exit Sub
err:
MsgBox ("找不到文件或文件格式不对")
End Sub
Private Sub 命令11_Click()
DoCmd.OpenTable "学生成绩"
End Sub
Private Sub 命令12_Click()
MsgBox ("提示：00表示年段，01表示一班，02表示二班.....")
DoCmd.OpenTable "质量分析"
End Sub
Private Sub 命令13_Click()
DoCmd.OpenQuery "temp"
End Sub
Private Sub 命令15_Click()
FollowHyperlink CurrentProject.Path & "\功能说明.doc"
End Sub
Private Sub 命令22_Click()
DoCmd.Quit acQuitSaveAll
End Sub
Private Sub 命令6_Click()
DoCmd.OpenForm "质量分析"
End Sub
Private Sub 命令7_Click()
DoCmd.OpenForm "导出结果"
End Sub
（2）质量分析窗体
各命令按钮VBA代码：
Private Sub 命令10_Click()
Dim kmzf(15) As Double
Dim kmmc(15) As String
For i = 1 To 11
kmzf(i) = Val(Me.Controls("txtzf" & i).Value)
Next
kmmc(1) = "数学"
kmmc(2) = "语文"
kmmc(3) = "英语"
kmmc(4) = "物理"
kmmc(5) = "化学"
kmmc(6) = "地理"
kmmc(7) = "政治"
kmmc(8) = "历史"
kmmc(9) = "生物"
kmmc(10) = "文综"
kmmc(11) = "理综"
Dim k As String
tt = False
k = ""
'Dim db As DAO.Database '声明数据库对象变量
Set db = CurrentDb()
db.Execute "DELETE * FROM 质量分析;"
For i = 1 To 11
If Me.Controls("check" & i) <> 0 Then
Call 统计(kmmc(i), kmzf(i), "00") '算年段三率
For j = Val(TXTbjks.Value) To Val(TXTbjks.Value) + bjzs - 1 If j < 10 Then
k = "0" & CStr(j)
Call 统计(kmmc(i), kmzf(i), k) '算班级三率
Else
k = CStr(j)
Call 统计(kmmc(i), kmzf(i), k)
End If
Next j
End If
Next i
If tt = False Then
MsgBox ("统计完毕，请返回主菜单导出结果打印")
End If
End Sub
Private Sub 命令97_Click()
Call 查询
End Sub
Private Sub 命令100_Click()
DoCmd.Close
End Sub
Private Sub 命令111_Click()
Dim kk As String
Call 计算总分
For i = Val(TXTbjks.Value) To Val(TXTbjks.Value) + Val(txtbjzs.Value) - 1
Debug.Print i
If i < 10 Then
kk = """0" & CStr(i) & "*"""
Else
kk = """" & CStr(i) & "*"""
End If
Debug.Print kk
Call RangBerechnen_bj("学生成绩", kk, "总分")
Next i
MsgBox ("处理完毕！")
End Sub
Private Sub 命令98_Click()
tt = True
'Call 计算总分
Call RangBerechnen("学生成绩", "总分") '年段排名
Call 查询
If tt Then
MsgBox ("统计完毕，请返回主菜单导出结果打印")
End If
End Sub
（3）导出结果窗体
各命令按钮VBA代码：
Private Sub 命令0_Click()
DoCmd.OutputTo acOutputQuery, "temp", acFormatXLS, CurrentProject.Path & "\学生站队表.xls"
MsgBox "导出完毕!结果为“成绩统计\学生站队表.xls”"
End Sub
Private Sub 命令1_Click()
DoCmd.OutputTo acOutputTable, "质量分析", acFormatXLS, CurrentProject.Path & "\质量分析.xls"
MsgBox "导出完毕!结果为“成绩统计\质量分析.xls”"
End Sub
Private Sub 命令3_Click()
DoCmd.Close
End Sub
（4）通用模块代码
Public tt As Boolean
Public i As Integer
Public j As Integer
Public str As String
Public bjzs As Integer
Public kmzf(15) '存放各科总分
Public kmmc(15) '存放科目名称
Sub 统计(km As String, kmzf As Double, jj As String)
Dim sum As Long
Dim intI As Long
Dim avg As Single
Dim gfli As Single
Dim jgli As Single
Dim strsql As String
Dim db As DAO.Database '声明数据库对象变量
Dim recName As DAO.Recordset '声明记录集对象变量
Dim strName As DAO.Field '声明字段对象变量
On Error GoTo wrong
Set db = CurrentDb() '指定数据库为当前数据库
If jj = "00" Then
Set recName = db.OpenRecordset("学生成绩") '计算年段
Else
Set recName = db.OpenRecordset("select * from 学生成绩 where 班号 like " & """" & jj & "*" & """") '计算班级
End If
Set strName = recName.Fields(km) '指定记录集“科目”字段
' 计算三率
jgrs = 0 '及格人数
sum = 0 '总分
gfrs = 0 '高分人数
intI = 0 '总人数
Do Until recName.EOF
sum = sum + IIf(IsNull(strName), 0, strName) ' 将“科目”字段读入数组If strName >= kmzf * 0.6 Then
jgrs = jgrs + 1 '及格人数
End If
If strName >= 0.8 * kmzf Then
gfrs = gfrs + 1 '高分的人数
End If
intI = intI + 1 '总人数
recName.MoveNext '读取记录集的下一行记录
Loop
avg = sum / intI '平均分
gfli = gfrs / intI '高分率
jgli = jgrs / intI '及格率
'写入“质量分析”表
Set recName = db.OpenRecordset("质量分析") '将“”表读入记录集recName.AddNew
recName.Fields(0) = jj
recName.Fields(1) = km
recName.Fields(2) = intI
recName.Fields(3) = jgrs
recName.Fields(4) = gfrs
recName.Fields(5) = avg
recName.Fields(6) = jgli
recName.Fields(7) = gfli
recName.Update
Exit Sub
wrong:
MsgBox ("找不到科目成绩或者班级总数设置不对!请检查并重新设置")
i = 11: j = 18000: tt = True
End Sub
'生成temp查询
Public Sub 查询()
Dim db As DAO.Database '声明数据库对象变量
Dim qry As DAO.QueryDef
Set db = CurrentDb()
For i = 0 To db.QueryDefs.Count - 1
If db.QueryDefs(i).Name = "temp" Then
DoCmd.DeleteObject acQuery, "temp"
End If
Next i
Set qry = db.CreateQueryDef("temp")
qry.SQL = "SELECT * FROM 学生成绩 ORDER BY 总分 DESC"
Set db = Nothing
End Sub
Public Sub 计算总分()
Dim db As DAO.Database '声明数据库对象变量
Dim recName As DAO.Recordset '声明记录集对象变量
Dim strName As DAO.Field '声明字段对象变量
kmmc(1) = "数学"
kmmc(2) = "语文"
kmmc(3) = "英语"
kmmc(4) = "物理"
kmmc(5) = "化学"
kmmc(6) = "地理"
kmmc(7) = "政治"
kmmc(8) = "历史"
kmmc(9) = "生物"
kmmc(10) = "文综"
kmmc(11) = "理综"
Set db = CurrentDb() '指定数据库为当前数据库
Set recName = db.OpenRecordset("学生成绩") '将“”表读入记录集
On Error GoTo err
Do Until recName.EOF
sum = 0
For i = 1 To 11
If Form_质量分析.Controls("check" & i) <> 0 Then
sum = sum + IIf(IsNull(recName.Fields(kmmc(i))), 0, recName.Fields(kmmc(i)))
End If
Next i
recName.Edit
recName.Fields("总分") = sum
recName.Update
recName.MoveNext
Loop
Exit Sub
err:
MsgBox "找不到成绩!请重新设置科目"
tt = False
End Sub
'计算名次
Public Function RangBerechnen(TableName As String, LeistungFeld As String) As Boolean On Error GoTo Err_Rang
Dim db As DAO.Database
Dim iRang As Long
Dim iLeistung As Integer
Dim iGleicherRang As Integer
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM " & TableName & " ORDER BY " & LeistungFeld & " DESC", dbOpenDynaset)
iRang = 1
With rst
Do While Not .EOF
iLeistung = .Fields(LeistungFeld)
.Edit
!年名 = iRang
.Update
.MoveNext
If .EOF Then Exit Do
iGleicherRang = 0
Do While (.Fields(LeistungFeld) = iLeistung)
.Edit
!年名 = iRang
.Update
iGleicherRang = iGleicherRang + 1
.MoveNext
If .EOF Then Exit Do
Loop
iRang = iRang + 1 + iGleicherRang
Loop
.Close
End With
RangBerechnen = True
Set db = Nothing
Set rst = Nothing
Exit_Rang:
Exit Function
Err_Rang:
RangBerechnen = False
Resume Exit_Rang
End Function
'计算班级名次
Public Function RangBerechnen_bj(TableName As String, tiaoj As String, LeistungFeld As String) As Boolean
On Error GoTo Err_Rang
Dim rst As DAO.Recordset
Dim iRang As Long
Dim iLeistung As Integer
Dim iGleicherRang As Integer
Dim sqlstr As String
sqlstr = "SELECT * FROM " & TableName & " where 班号 like " & tiaoj & " ORDER BY " & LeistungFeld & " DESC;"
Set db = CurrentDb
Set rst = db.OpenRecordset(sqlstr, dbOpenDynaset)
iRang = 1
With rst
Do While Not .EOF
iLeistung = .Fields(LeistungFeld)
.Edit
!班名 = iRang
.Update
.MoveNext
If .EOF Then Exit Do
iGleicherRang = 0
Do While (.Fields(LeistungFeld) = iLeistung)
.Edit
!班名 = iRang
.Update
iGleicherRang = iGleicherRang + 1
.MoveNext
If .EOF Then Exit Do
Loop
iRang = iRang + 1 + iGleicherRang
Loop
.Close
End With
RangBerechnen_bj = True
Set db = Nothing
Set rst = Nothing
Exit_Rang:
Exit Function
Err_Rang:
RangBerechnen_bj = False
Resume Exit_Rang
End Function