使用宏實現(xiàn)自動批改office操作題

1、使用宏實現(xiàn)自動批改office操作題雙擊excel文件圖標 單擊中間的啟用宏按鈕如果出現(xiàn)下面的提示，單擊中“是”啟用宏之后出現(xiàn)如下內(nèi)容：按要求完成后，單擊評分按鈕，會完成評分，如圖;注意：如不能自動評分，請把excel另存為的方式保存成一個獨立的文件后再執(zhí)行。參考如下內(nèi)容，可以自己制作其它自動批改的練習文件。Dim XINMING, banji As StringDim FEN As IntegerSub 宏1()FEN = 0XINMING = InputBox("請輸入姓名")banji = InputBox("請輸入班級，如：92") Dim fi

2、leso As New Scripting.FileSystemObjectDim ts As TextStream'設置記錄內(nèi)容的路徑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(&

3、quot;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 = Tru

4、e 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(&q

5、uot;F13") = "字體NO" ' If .Name = "宋體" Then Range("F13") = "字體0k": FEN = FEN + 10: ts.Write " 字體0k " ' If .Name <> "宋體" Then Range("F13") = "字體NO" '.FontStyle = "常規(guī)" ' .Size = 14 '

6、.Strikethrough = False ' .Superscript = False '.Subscript = False ' .'OutlineFont = False ' .Shadow = False ' .Underline = xlUnderlineStyleNone ' .ColorIndex = 5 'End With '判斷賦值Range("E8") = "36541" ' If Range("E4") = "0"

7、; 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").Select If ActiveCell.FormulaR1C1 = "=SU

8、M(RC-3:RC-1)" Then FEN = FEN + 10: ts.Write " 1教齡0k " Range("E3").Select If ActiveCell.FormulaR1C1 = "=SUM(RC-3:RC-1)" Then FEN = FEN + 10: ts.Write " 21教齡0k " Range("E4").Select If ActiveCell.FormulaR1C1 = "=SUM(RC-3:RC-1)" Then FEN =

9、 FEN + 10: ts.Write " 13教齡0kk " Range("E5").Select If ActiveCell.FormulaR1C1 = "=SUM(RC-3:RC-1)" Then FEN = FEN + 10: ts.Write " 4教齡0k " Range("E6").Select If ActiveCell.FormulaR1C1 = "=SUM(RC-3:RC-1)" Then FEN = FEN + 10: ts.Write "51

10、教齡0kk " Range("E7").Select If 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 &quo

11、t;'求和 Range("B8").Select If ActiveCell.FormulaR1C1 = "=AVERAGE(R-6C:R-1C)" Then FEN = FEN + 10 ': ts.Write "求和0k " Range("c8").Select If ActiveCell.FormulaR1C1 = "=AVERAGE(R-6C:R-1C)" Then FEN = FEN + 10 ': ts.Write "求和0k " Rang

12、e("d8").Select If ActiveCell.FormulaR1C1 = "=AVERAGE(R-6C:R-1C)" Then FEN = FEN + 10 ': ts.Write "求和0k " Range("e8").Select If ActiveCell.FormulaR1C1 = "=AVERAGE(R-6C:R-1C)" Then FEN = FEN + 10 ': ts.Write "求和0k " ''記錄姓名、班級、

13、分數(shù)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