有个爱学习的小朋友要突击英语,需要做一些填空题目,重要的单词已经用下划线标记出来了。
制作填空题时,需要保留单词的第一个字母,这样可以提示答题者,后面是空格由于填空。
如果按人工逐个单词去修改,估计要搞到地老天荒了,幸好有VBA这个法宝,当然这样的处理肯定是Word VBA,而不是Excel VBA了。
代码如下:
Sub Demo1()
Dim sen As Range, wor As Range
For Each sen In ActiveDocument.Sentences
For Each wor In sen.Words
If wor.Underline = 1 Then
wor.Start = wor.Start + 1
wor.End = wor.End - (VBA.Len(wor) - VBA.Len(Trim(wor)))
wor.Text = Space(VBA.Len(Trim(wor)))
End If
Next
Next
End Sub
【代码解析】
第3~11行代码使用For…Next循环遍历当前文档的全部Sentence对象。
第4~10行代码使用For…Next循环遍历Sentence对象中的全部Word对象。
如果Word对象具备下划线格式,那么将是需要处理为填空的单词。
如果一个英文单词后面是空格,那么Word对象是包括这个尾随空格的,如果英文单词之后是标点符号,那么Word对象不包含标点符号。选中Word对象可以看到效果,如下图所示。
第6行代码将其实位置后移一位,保留第一字母
第7行代码根据Trim之后的字符长度变化,来判断是否包含尾随空格。如果有尾随空格,在将Word对象的End字符位置前移一位,避免替换尾随空格。
第8行代码替换单词为填空形式。
另一种实现方式,Word中可以进行按格式查找,代码如下。
Sub Demo2()
Set cont = ActiveDocument.Content
With cont.Find
.Font.Underline = wdUnderlineSingle
Do While .Execute
cont.Start = cont.Start + 1
cont.Text = Space(Len(cont.Text))
Loop
End With
End Sub
【代码解析】
第4行代码设置查找下划线格式。
第5~8行循环查找全部匹配的单词,并完成替换。
运行代码,立刻搞定,学习也可以这么简单!