Excel WordVBA中字符串查找替换进阶

Word文档中有表格、有字符格式、有自选图形（浮动式自选图形）、有嵌入式图片、有浮动式图片等，替换位置有这些对象，查找替换也不会有影响。
原因：第一个for each循环是按照遍历段落，在所有的段落中查找得到多个range对象并重新定义的range对象变量，并把查找到的所有的range对象按照循序储存到一个集合；第二个for   j循环是逐个从集合中取出之前查找到的range对象并逐个替换查找到的range对象。不会有任何的影响啊？
顺便更正以下：这句定义变量 Dim i%, mt, oRang As Range, n%, m%  由于笔误，i变量不是整型变量，是段落对象。现把这句更正为：Dim i As Paragraph, mt, oRang As Range, n%, m%
查找替换原理：

将一个 Range 对象变量设置为等于另一个 Range 对象变量

下列指令（语句）将名为 Range2 的区域变量设为与 Range1 代表的位置相同。

Set Range2 = Range1   '译为：设置Range2对象与 Range1 代表的位置相同

现在两个变量代表同一区域。修改 Range2 的起点、终点或其中的文本将影响 Range1，反之亦然。

1. Sub 第一条()
   
2.     Selection.HomeKey unit:=wdStory
   
3.     Selection.Find.ClearFormatting
   
4.     Do While Selection.Find.Execute(findtext:=vbCr & "第[一二三四五六七八九十百零千0-9]@条", Forward:=True, MatchWildcards:=True)
   
5.         Selection.MoveStart unit:=wdCharacter, Count:=1
   
6.         Selection.InsertAfter Text:=Chr(-24159)
   
7.         Selection.MoveEnd unit:=wdCharacter, Count:=-1
   
8.         With Selection.Font
   
9.             .Name = "黑体"
   
10.             .Name = "Times New Roman"
    
11.             .Bold = True
    
12.             .Color = wdColorPink '粉红
    
13.         End With
    
14.         Selection.EndKey unit:=wdLine
    
15.     Loop
    
16. End Sub

正则表达式：

Sub Word文档中查找替换并设置格式()

   Dim col As New Collection, k&, Crng As Range

   Dim mt, oRang As Range, j%, n%, m%

   Set Crng = ActiveDocument.Content

   With CreateObject("vbscript.regexp")

      .Pattern = "^第[一二三四五六七八九十百零千\d]+条"

      .Global = True: .MultiLine = True

      For Each mt In .Execute(Crng)

         k = k + 1

         m = mt.FirstIndex: n = mt.Length

         Set oRang = ActiveDocument.Range(Crng.Start + m, Crng.Start + m + n)

         col.Add oRang, CStr(k)

      Next

   End With

   For j = 1 To col.Count

      With col(j).Font

         .Name = "黑体"

         .Name = "Times New Roman"

         .Bold = True

         .Color = wdColorPink

         col(j).InsertAfter Text:=Chr(-24159)

      End With

   Next

End Sub