这个事源于公司想简化面试流程，希望能通过一些简单的笔试及自动阅卷来提高对候选人的初步筛选工作的效率和准确性。我当时的想法是这样的：
1. 利用AI工具生成一个笔试题库，只要选择题和填空题
2. 利用VBA工具，根据需求自动从题库里抽取响应的题目，生成试卷
3. 答完试卷后，能自动进行阅卷打分
我花了差不多半天时间，做了一个小Demo来验证这个思路。不过这个事后来“夭折”了，因为稍微调研一下就知道，现在已经有很多成熟的可以帮你生成试卷并自动阅卷的考试系统了，而且收费也不贵，确实是用不上用Word来做这样一个简陋的系统。但是Demo做都做了，那就放出来，供有需要的朋友参考。
先看看运行效果：
简易考试系统
后续可以在考卷文件里加一个倒计时，并从题库里随机抽题，在做一些界面美化。这得看心情。
实现这个系统主要用到了Word的控件功能，在这里：
代码比较简单。这块稍微说一下阅卷的逻辑，我的试题其实是以表格的形式存储的，如下图：
我在生成试卷的时候，将对应试题答案的表格行列号存到了内容控件的Tag里，这样在阅卷的时候，只需要读取相应内容控件的Tag，解析出答案所在单元格的表格序号和行列号，然后读取题库中的答案和试卷上的答案进行对比就好了。
生成试卷的核心代码如下：
Private Sub GenTest_Click()Dim cc As ContentControlDim post, level, time, cnum, jnum As StringDim rootPath As StringrootPath = ActiveDocument.PathFor Each cc In ActiveDocument.ContentControlsIf cc.Title = "Post" Thenpost = cc.Range.TextElseIf cc.Title = "Level" Thenlevel = cc.Range.TextElseIf cc.Title = "Time" Thentime = cc.Range.TextElseIf cc.Title = "ChoiceNum" Thencnum = cc.Range.TextElseIf cc.Title = "JudgeNum" Thenjnum = cc.Range.TextEnd IfNext ccDim quesDoc, newDoc As DocumentSet quesDoc = Documents.Open(rootPath + "\Database\" + "C++\" + "0" + ".docx")Set newDoc = Documents.Add()newDoc.ActivateSelection.TypeText "选择题（共" + cnum + "道）" + Chr(13)For i = 2 To CInt(cnum) + 1Selection.TypeText quesDoc.Tables(1).Cell(i, 1).Range.TextSelection.TypeText "答案："Set cc = newDoc.ContentControls.Add(wdContentControlDropdownList)cc.Tag = "1," + CStr(i)cc.DropdownListEntries.Add "A"cc.DropdownListEntries.Add "B"cc.DropdownListEntries.Add "C"cc.DropdownListEntries.Add "D"Selection.MoveRight wdCharacter, 2Selection.TypeText Chr(13) + Chr(13)Next iSelection.TypeText "判断题（共" + cnum + "道）" + Chr(13)For i = 2 To CInt(jnum) + 1Selection.TypeText quesDoc.Tables(2).Cell(i, 1).Range.TextSelection.TypeText "答案："Set cc = newDoc.ContentControls.Add(wdContentControlDropdownList)cc.Tag = "2," + CStr(i)cc.DropdownListEntries.Add "对"cc.DropdownListEntries.Add "错"Selection.MoveRight wdCharacter, 2Selection.TypeText Chr(13) + Chr(13)Next iquesDoc.ClosenewDoc.Protect wdAllowOnlyFormFields, False, "tianta"newDoc.SavenewDoc.CloseEnd Sub阅卷的核心代码如下：
Sub CheckPaper()Dim rootPath As StringrootPath = ActiveDocument.PathDim dlgOpen As FileDialogSet dlgOpen = Application.FileDialog( _FileDialogType:=msoFileDialogOpen)With dlgOpen.ShowEnd WithDim paperDoc, quesDoc As DocumentSet paperDoc = Documents.Open(dlgOpen.SelectedItems(1))'paperDoc.Unprotect "tianta"Set quesDoc = Documents.Open(rootPath + "\Database\" + "C++\" + "0" + ".docx")paperDoc.ActivateDim cc As ContentControlDim all, right, wrong As IntegerFor Each cc In paperDoc.ContentControlsall = all + 1res = cc.Range.TextposArr = Split(cc.Tag, ",")i = CInt(posArr(0))j = CInt(posArr(1))ans = Left(quesDoc.Tables(i).Cell(j, 2).Range.Text, 1)If res = ans Thenright = right + 1Elsewrong = wrong + 1End IfNext ccMsgBox "共" + CStr(all) + "题" + Chr(13) + "做对" + CStr(right) + "题" + Chr(13) + "做错" + CStr(wrong) + "题" + Chr(13) + "得" + CStr(right / all * 100) + "分"paperDoc.ClosequesDoc.CloseEnd Sub完整工程代码可以从这里下载：https://download.csdn.net/download/lc19890709/90025102