Word VBA快速制作填空题
实例需求:Word文档用于英语单词学习,重点记忆单词标记下划线,其内容如下图所示。
现在文档转换为填空题(无论单词字符多少,填空部分统一使用10个空格)和参考答案两部分,如下图所示。
示例代码如下。
Sub Demo()Dim oDoc As Document: Set oDoc = ActiveDocumentDim oRng As Range: Set oRng = oDoc.RangeDim iEnd As Long: iEnd = oRng.EndoRng.InsertParagraphAfteroRng.Paragraphs.Last.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraphoRng.CopyoRng.Characters.Last.InsertAfter vbCr & "参考答案" & vbCroRng.Collapse Direction:=wdCollapseEndoRng.PasteDim pasteRange As RangeSet pasteRange = oDoc.Range(oRng.Start, oDoc.Range.End)If pasteRange.ListFormat.ListType <> wdListNoNumbering ThenpasteRange.ListFormat.ApplyListTemplate _ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1), _ContinuePreviousList:=FalseEnd IfSet oRng = oDoc.Range(0, iEnd)With oRng.Find.ClearFormatting.Replacement.ClearFormatting.Font.Underline = wdUnderlineSingle.Forward = True.Wrap = wdFindStop.Replacement.Text = String(10," ").Execute Replace:=wdReplaceAllEnd With
End Sub
【代码解析】
第2行代码获取当前的活动Word文档。
第3行代码获取文档的Range对象引用。
第4行代码获取文档的结束位置。
第5行代码在文档最后插入段落标记。
第6行代码移除最后一个段落的编号样式。
第7行代码复制文档内容到剪贴板。
第8行代码在文档末尾插入“参考答案”段落。
第9行代码将范围折叠到文档末尾。
第10行代码在当前位置(即文档末尾)粘贴剪贴板内容。
第12行代码获取新粘贴部分文档的Range对象。
第13行代码判断使用使用的编号格式。
如果有编号,第14~16行代码则应用新的编号格式(使用数字库中的第一个模板),并重新开始编号。
第18行代码获取原始文档的Range对象引用。
第20行代码清除查找格式。
第21行代码清除替换格式。
第22行代码设置查找下划线字体格式。
第23行代码指定向前查找。
第24行代码指定查找结尾就停止。
第25行代码指定替换文本为10个空格。
第26行代码替换全部重点单词为空格。