Word VBA快速制作填空题

taller_20002025-06-10 23:46

实例需求：Word文档用于英语单词学习，重点记忆单词标记下划线，其内容如下图所示。

现在文档转换为填空题（无论单词字符多少，填空部分统一使用10个空格）和参考答案两部分，如下图所示。

示例代码如下。

复制代码

Sub Demo()
    Dim oDoc As Document: Set oDoc = ActiveDocument
    Dim oRng As Range: Set oRng = oDoc.Range
    Dim iEnd As Long: iEnd = oRng.End
    oRng.InsertParagraphAfter
    oRng.Paragraphs.Last.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
    oRng.Copy
    oRng.Characters.Last.InsertAfter vbCr & "参考答案" & vbCr
    oRng.Collapse Direction:=wdCollapseEnd
    oRng.Paste
    Dim pasteRange As Range
    Set pasteRange = oDoc.Range(oRng.Start, oDoc.Range.End)
    If pasteRange.ListFormat.ListType <> wdListNoNumbering Then
        pasteRange.ListFormat.ApplyListTemplate _
                ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1), _
                ContinuePreviousList:=False
    End If
    Set oRng = oDoc.Range(0, iEnd)
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Font.Underline = wdUnderlineSingle
        .Forward = True
        .Wrap = wdFindStop
        .Replacement.Text = String(10," ")
        .Execute Replace:=wdReplaceAll
    End 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行代码替换全部重点单词为空格。