快速替換指定單詞

有個愛學習的小朋友要突擊英語，需要做一些填空題目，重要的單詞已經用下劃線標記出來了。

製作填空題時，需要保留單詞的第一個字母，這樣可以提示答題者，後面是空格由於填空。

如果按人工逐個單詞去修改，估計要搞到地老天荒了，幸好有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行循環查找全部匹配的單詞，並完成替換。

---

運行代碼，立刻搞定，學習也可以這麼簡單！