利用宏实现成绩登记表

核心提示： 'Score_Statistic自定义过程代码PrivateSubScore_Statistic(ByValrowAsInteger,ByValcolumnAsInteger)Dimgrade(3)AsSingle,totalAsSingleWithThisDocument.Tables

'Score_Statistic自定义过程代码

Private　Sub　Score_Statistic(ByVal　row　As　Integer,　ByVal　column　As　Integer)
Dim　grade(3)　As　Single,　total　As　Single
With　ThisDocument.Tables.Item(1)
'调用自定义函数Convert_Int进行字符型数据到数值型数据转换
If　Len(Trim(.Cell(row　+　1,　column　+　2).Range.Text))　=　2　Then　　　　'缺考
　　　　.Cell(row　+　1,　column　+　3).Range.Text　=　"缺考"
　　　　grade(1)　=　Convert_Int(.Cell(row　+　1,　column).Range.Text)　　　　　　　　'平时成绩
　　　　grade(2)　=　Convert_Int(.Cell(row　+　1,　column　+　1).Range.Text)　　　　　'实验成绩
　　　　grade(3)　=　-1
　　　　total　=　-1　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'不缺考
　　　　grade(1)　=　Convert_Int(.Cell(row　+　1,　column).Range.Text)　　　　　　　　'平时成绩
　　　　grade(2)　=　Convert_Int(.Cell(row　+　1,　column　+　1).Range.Text)　　　　　'实验成绩
　　　　grade(3)　=　Convert_Int(.Cell(row　+　1,　column　+　2).Range.Text)　　　'期末成绩
　　　　'期末考试成绩小于45分,总成绩为期末考试成绩
　　　　If　exam_or_check　Then　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'考试
　　　　　　total　=　IIf(grade(3)　<　45,　grade(3),　Round((grade(1)　*　proportion(1)　+　grade(2)　*　proportion(2)　+　grade(3)　*　proportion(3))　/　100,　0))
　　　　　　.Cell(row　+　1,　column　+　3).Range.Text　=　total
　　　　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'考查
　　　　　　total　=　Round((grade(1)　*　proportion(1)　+　grade(2)　*　proportion(2)　+　grade(3)　*　proportion(3))　/　100,　0)
　　　　　　.Cell(row　+　1,　column　+　3).Range.Text　=　IIf(total　>=　90,　"优",　IIf(total　>=　80,　"良",　IIf(total　>=　70,　"中",　IIf(total　>=　60,　"及格",　IIf(total　>=　0,　"不及格",　"")))))
　　　　End　If
　　End　If
　　'各项成绩小于60分加框
　　.Cell(row　+　1,　column).Range.Font.Borders.Enable　=　IIf(grade(1)　>=　0　And　grade(1)　<　60,　True,　False)
　　.Cell(row　+　1,　column　+　1).Range.Font.Borders.Enable　=　IIf(grade(2)　>=　0　And　grade(2)　<　60,　True,　False)
　　.Cell(row　+　1,　column　+　2).Range.Font.Borders.Enable　=　IIf(grade(3)　>=　0　And　grade(3)　<　60,　True,　False)
　　.Cell(row　+　1,　column　+　3).Range.Font.Borders.Enable　=　IIf(total　>=　0　And　total　<　60,　True,　False)
　　'期末考试成绩小于45分,加阴影
　　If　exam_or_check　Then
　　　　.Cell(row　+　1,　column　+　3).Range.Shading.BackgroundPatternColor　=　IIf(grade(3)　>=　0　And　grade(3)　<　45,　wdColorGray20,　wdColorWhite)
　　Else
　　　　.Cell(row　+　1,　column　+　3).Range.Shading.BackgroundPatternColor　=　wdColorWhite
　　End　If
　　'统计成绩分布
　　Select　Case　total
　　　　Case　Is　>=　90　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'优秀
　　　　　　grade_proportion(1,　1)　=　grade_proportion(1,　1)　+　1
　　　　Case　Is　>=　80　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'良好
　　　　　　grade_proportion(1,　2)　=　grade_proportion(1,　2)　+　1
　　　　Case　Is　>=　70　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'中等
　　　　　　grade_proportion(1,　3)　=　grade_proportion(1,　3)　+　1
　　　　Case　Is　>=　60　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'及格
　　　　　　grade_proportion(1,　4)　=　grade_proportion(1,　4)　+　1
　　　　Case　Is　>=　0　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'不及格
　　　　　　grade_proportion(1,　5)　=　grade_proportion(1,　5)　+　1
　　　　Case　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'缺考
　　　　　　grade_proportion(1,　6)　=　grade_proportion(1,　6)　+　1
　　End　Select
　　'统计考试课程卷面成绩小于45分
　　If　exam_or_check　Then
　　　　If　grade(3)　>=　0　And　grade(3)　<　45　Then
　　　　　　grade_proportion(1,　7)　=　grade_proportion(1,　7)　+　1
　　　　End　If
　　End　If
　　End　With
End　Sub

自定义函数Convert_Int代码:

Private　Function　Convert_Int(ByRef　Txt　As　String)　As　Integer
　　Dim　Score　As　String　*　1
　　If　Asc(Txt)　>　0　Then　　　　　　　　　　　　　　　　　　　　　　　　'数字
　　　　Convert_Int　=　Val(Txt)
　　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　Score　=　Txt
　　　　Convert_Int　=　IIf(Score　=　"优",　95,　IIf(Score　=　"良",　85,　IIf(Score　=　"中",　75,　IIf(Score　=　"及",　65,　55))))
　　End　If
End　Function
　
｀全局变量声明
Option　Base　1
Option　Explicit
Dim　exam_or_check　As　Boolean
Dim　grade_proportion(2,　7)　As　Single
Dim　proportion(3)　As　Integer
Private　Const　Message_Title　=　"江苏技术师范学院学生成绩登记系统"