使用宏实现自动批改office操作题.doc

使用宏实现自动批改 office 操作题双击 excel 文件图标 单击中间的启用宏按钮如果出现下面的提示，单击中“是”启用宏之后出现如下内容：自 动 测 评 .XLS按要求完成后，单击评分按钮，会完成评分，如图;注意：如不能自动评分，请把 excel 另存为的方式保存成一个独立的文件后再执行参考如下内容，可以自己制作其它自动批改的练习文件Dim XINMING, banji As StringDim FEN As IntegerSub 宏 1()FEN = 0XINMING = InputBox("请输入姓名")banji = InputBox("请输入班级，如：92")Dim fileso As New Scripting.FileSystemObjectDim ts As TextStream'设置记录内容的路径Set ts = fileso.OpenTextFile("e:\excel-fen.txt", ForAppending, 1)ts.Write "DB "''' 宏 1 宏表' user 记录的宏 2000-1-14'记录工作表换名'On Error GoTo 20'Sheets("人力资源情况表 ").Select' Range("E12") = "换名 0k": FEN = FEN + 10: ts.Write " 换名 0k "' GoTo 30'20: Range("E12") = "换名 NO": ts.Write " 换名 no "'30:'刻录合并单元格' Range("A1:C1").Select'With Selection' .MergeCells = True' If .MergeCells = True Then Range("E13") = "合并 0k": FEN = FEN + 10: ts.Write " 合并 0k "' If .MergeCells = 0 Then Range("E13") = "合并 NO": ts.Write " 合并 no "' End With'记录设置字体'Range("A17:G19").Select' With Selection.Font' Range("F13") = "字体 NO"' If .Name = "宋体" Then Range("F13") = "字体 0k": FEN = FEN + 10: ts.Write " 字体 0k "' If .Name <> "宋体" Then Range("F13") = "字体 NO"'.FontStyle = "常规"' .Size = 14' .Strikethrough = False' .Superscript = False'.Subscript = False' .'OutlineFont = False' .Shadow = False' .Underline = xlUnderlineStyleNone' .ColorIndex = 5'End With'判断赋值 Range("E8") = "36541"' If Range("E4") = "0" Then Range("E10") = "赋值 0k": FEN = FEN + 10: ts.Write " 赋值 0k "' Range("E9").Select '使用公式求百分比If Range("E1") = "总分" Then FEN = FEN + 10: ts.Write "插入成功 0k "Range("E2").SelectIf ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" Then FEN = FEN + 10: ts.Write " 1 教龄 0k "Range("E3").SelectIf ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" Then FEN = FEN + 10: ts.Write " 21 教龄 0k "Range("E4").SelectIf ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" Then FEN = FEN + 10: ts.Write " 13 教龄 0kk "Range("E5").SelectIf ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" Then FEN = FEN + 10: ts.Write " 4 教龄 0k "Range("E6").SelectIf ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" Then FEN = FEN + 10: ts.Write "51 教龄 0kk "Range("E7").SelectIf ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" Then FEN = FEN + 10: ts.Write " 6 教龄 0k "'设置％格式' Range("C3:C6").Select' If Selection.NumberFormatLocal = "0.0%" Then FEN = FEN + 10: ts.Write " 4 设置％格式 0k "'求和Range("B8").SelectIf ActiveCell.FormulaR1C1 = "=AVERAGE(R[-6]C:R[-1]C)" Then FEN = FEN + 10 ': ts.Write "求和 0k "Range("c8").SelectIf ActiveCell.FormulaR1C1 = "=AVERAGE(R[-6]C:R[-1]C)" Then FEN = FEN + 10 ': ts.Write "求和 0k "Range("d8").SelectIf ActiveCell.FormulaR1C1 = "=AVERAGE(R[-6]C:R[-1]C)" Then FEN = FEN + 10 ': ts.Write "求和 0k "Range("e8").SelectIf ActiveCell.FormulaR1C1 = "=AVERAGE(R[-6]C:R[-1]C)" Then FEN = FEN + 10 ': ts.Write "求和 0k "'‘'记录姓名、班级、分数ts.WriteLinets.Write XINMING'ts.Write " "ts.Write banji'ts.Write " "ts.Write FENMsgBox ("祝贺 " & XINMING & "你得了：" & FEN - 10 & "分！")ts.Write " stu"ts.WriteLinets.WriteLine'Set ts = fileso.OpenTextFile("\\teacher\考试$\excel-fen.txt", ForAppending, 1)ts.Write "DB "'ts.Write ActiveCell.FormulaR1C1ts.WriteLine'ts.Write Range("E9")ts.Write XINMING'ts.Write " "ts.Write banji'ts.Write " "ts.Write FEN & "分！"ts.Write " stu"'ts.Write ActiveCell.FormulaR1C1ts.WriteLine'Set ts = fileso.OpenTextFile("e:\excel-fen.txt", ForAppending, 1)End Sub。