Word VBA快速制作试卷(2/2)
实例需求：英语听力题目及其答案（题目编号之前括号内字母为答案）如下所示。
现在需要将文档整理为如下格式：
- 第一部分为听力题目，擅长每个题目编号之前的答案（包含括号）
- 增加一个段落“参考答案”
- 第3部分为听力题目含参考答案，并修改英语如下格式
– 题目编号之前的答案应用红色字体
– 题目答案选项应用红色字体和下划线
其效果如下图所示。
Sub Demo()Dim oDoc As Document: Set oDoc = ActiveDocumentDim oRng As Range: Set oRng = oDoc.RangeDim iEnd As Long: iEnd = oRng.EndoRng.CopyoRng.InsertParagraphAfteroRng.Paragraphs.Last.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraphoRng.Characters.Last.InsertAfter vbCr & "参考答案" & vbCroRng.Collapse Direction:=wdCollapseEndoRng.PasteDim pasteRange As RangeSet pasteRange = oRngIf pasteRange.ListFormat.ListType <> wdListNoNumbering ThenpasteRange.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:=FalseEnd IfDim oAnswer As Range, sAnswer As StringWith pasteRange.Find.ClearFormatting.Wrap = wdFindStop.MatchWildcards = True.Text = "\( [A-Z] \)"Do While .ExecuteWith .ParentsAnswer = Trim(Mid(.Text, 2, Len(.Text) - 2))Set oAnswer = .Paragraphs(1).Next.Range.Font.ColorIndex = wdRedEnd WithWith oAnswer.Find.ClearFormatting.Wrap = wdFindStop.MatchWildcards = True.Text = sAnswer & "\. <*>\.".Replacement.Font.ColorIndex = wdRed.Replacement.Font.Underline = wdUnderlineSingle.Execute Replace:=wdReplaceAllEnd WithLoopEnd WithSet oRng = oDoc.Range(0, iEnd)With oRng.Find.ClearFormatting.Replacement.ClearFormatting.Text = "\( [A-Z] \)".Replacement.Text = "".Forward = True.Wrap = wdFindStop.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = False.MatchAllWordForms = False.MatchSoundsLike = False.MatchWildcards = True.Execute Replace:=wdReplaceAllEnd With
End Sub
【代码解析】
第2行代码获取当前活动文档对象，并赋值给变量 oDoc。
第3行代码获取整个文档的范围Range对象，用于后续内容操作。
第4行代码记录当前文档末尾位置的字符索引，用于后续定位处理前的内容（即原始文档内容）。
第5行代码将整个文档复制到剪贴板。
第6行代码在文档末尾插入一个新的段落，以便后续插入答案内容。
第7行代码移除最后一个段落中可能存在的编号格式，确保复制内容时格式统一。
第8行代码在文档末尾插入段落标记和“参考答案”（作为一个单独段落），用于标识复制内容的开始。
第9行代码将范围折叠到末尾，准备粘贴剪贴板中的内容。
第10行代码将先前复制的内容粘贴到“参考答案”段落之后。
粘贴操作完成之后，oRng对象将代表新粘贴的文档内容，即oRng的范围发生了变化。
第11行代码定义一个新的范围对象 pasteRange，用于表示刚刚粘贴的答案区域。
第12行代码将 pasteRange 设置为粘贴内容。
第13-15行代码判断 pasteRange 是否存在编号，如果存在则重新应用编号样式，使粘贴内容具有统一格式。
第16行代码定义两个变量用于存储当前查找到的答案内容和操作范围。
第21行代码配置查找条件，使用通配符查找模式\( [A-Z] \)，查找形如( A )的选项格式。
第22~37行代码为查找循环，逐个处理答案标记。
第23~27行代码提取选项字母（去除括号），并标红原始答案位置。
第28-36行代码在答案区域查找与选项内容匹配的题干项（如 A. 正确），将其字体颜色设置为红色，并加下划线，标示正确答案。
第39行代码重新设置范围对象 oRng 为从文档开头到原始末尾（iEnd）之前的内容（即不包括新粘贴的“参考答案”及其之后的内容），准备查找操作。
第43~44行代码设置查找条件，并将其替换为空字符串，删除所有题目前的答案选项编号。
第54行执行全部替换。