查找使用给定颜色格式化的所有文本答案

【问题标题】：Find all text formatted with given color查找使用给定颜色格式化的所有文本
【发布时间】：2016-09-29 04:10:48
【问题描述】：

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

到目前为止我写的内容见下文，但我被困在这里：

到达文档末尾时如何停止循环？或者如何为我的代码添加智能以避免静态循环，而是“扫描我的所有文档”？

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

【问题讨论】：

您可以使用For i = 1 To ThisDocument.Words.Count - 1 遍历文档中的所有单词，然后您可以使用ThisDocument.Words(i) 访问该单词
目前，我想尽可能多地进行搜索...但是如果我能计算出有多少次出现，那么我对你的方法很好，谢谢。跨度>
有大量关于在 Word 中使用 Find 的示例，很难相信您还没有找到它们...Find.Execute 返回一个布尔值 - 如果查找成功，则返回 True。声明一个布尔变量，将其设置为 True 或 False，并在 Find 周围的 Do-loop 中使用它，测试 Find.Execute 是否成功。如果是，请继续；如果没有，则循环结束。您在代码中已有的wdFindStop 将阻止 Word 在文档顶部重新启动。

标签： vba ms-word format find-replace

【解决方案1】：

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

借助 Word 的宏记录器定义您要查找的格式
将自己置于文档的开头
使用while循环检查wdFindStop——它还演示了如何在VBA中使用字符串数组——：

...

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)

【讨论】：