查找所有格式为给定颜色的文本

Question

我正在寻找一种方法来创建一个新文档，其中包含我文档中具有特定格式的所有文本。

请参阅下面我到目前为止所写的内容，但我被困在这里：

到达文档末尾时如何停止循环？或者如何为我的代码添加智能以避免静态循环，而是执行 "scan all my document"?

Option Explicit

Sub Macro1()
   Dim objWord  As Application
   Dim objDoc As Document
   Dim objSelection As Selection

    Dim mArray() As String
    Dim i As Long
    Dim doc As Word.Document

    For i = 1 To 100
      ReDim Preserve mArray(i)
      With Selection.Find
        .ClearFormatting
        .Font.Color = wdColorBlue
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .Execute
      End With

      mArray(i) = Selection.Text

    Next

   Set objWord = CreateObject("Word.Application")
   Set objDoc = objWord.Documents.Add
   objWord.Visible = True
   Set objSelection = objWord.Selection

    For i = 1 To 100
    objSelection.TypeText (mArray(i))
    Next
End Sub

Answer 1

感谢 Cindy 的好提示（我也可以在 Loop through Word document, starting from beginning of file at start of each loop 中找到相关信息），以防有一天这对某人有所帮助：

借助 Word 的宏记录器定义您要查找的格式
将自己放在文档的开头
Use a while loop checking wdFindStop -- 它还演示了如何在 VBA--:
[ 中使用字符串数组=35=]

...

Sub Macro2()
    Dim mArray() As String
    Dim i As Long, n As Long
    Dim doc As Word.Document
    Dim isFound As Boolean
    isFound = True
    i = 1
    'For i = 1 To 40
    Do While (isFound)
      ReDim Preserve mArray(i)
      With Selection.Find
        .ClearFormatting
        .Font.Color = wdColorBlue
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        isFound = .Execute
      End With
      mArray(i) = Selection.Text
      i = i + 1
    Loop
    'Next
    n = i - 2
    MsgBox n & " occurrences found."

    '
    ' create a new document with the phrases found

    Dim objWord  As Application
    Dim objDoc As Document
    Dim objSelection As Selection
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = True
    Set objSelection = objWord.Selection
    For i = 1 To n 'mArray's Size
      objSelection.TypeText (mArray(i))
      objSelection.TypeParagraph
    Next
End Sub

注意：https://msdn.microsoft.com/en-us/library/office/aa211953%28v=office.11%29.aspx 解释了如何在不更改选择的情况下进行查找：

我也从中受益匪浅：

 With ActiveDocument.Content.Find
  .Text = "blue"
  .Forward = True
  .Execute
  If .Found = True Then .Parent.Bold = True
 End With

从这里开始：Find text only of style "Heading 1" (Range.Find to match style)

查找所有格式为给定颜色的文本

Find all text formatted with given color

vba

ms-word

format

find-replace