查找以给定颜色格式化的所有文本 [英] Find all text formatted with given color

问题描述

请参阅下面的内容，但我卡在这里：

• 如何在文档结束时停止循环？或者如何添加智能到我的代码，以避免静态循环，而是做一个扫描我的文档？
  
  
  $ hr
  
  

    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至100 
   ReDim保留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.Selectio n 
   
  对于i = 1至100 
   objSelection.TypeText（mArray（i））
  下一个
  结束小组
    

  
  

  解决方案

  感谢Cindy的好建议（我也可以在通过Word文档循环，从开始的文件开始每一个循环），并在某些日子可以帮助某人：
  
  

  
  

  1. 定义您正在查找的格式感谢Word的宏记录器

  
  

  2. 把自己定位在文档的开始处

  使用而循环检查 wdFindStop - 它还演示了如何在VBA中使用字符串数组： b
  
  
  
  $ b $ p $ $ $ $ c> 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（isFound）
  ReDim保留mArray（i）
  随着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& 发现事件
  
  '
  '用找到的短语创建一个新文档
  
  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
  对于i = 1到n'mArray的大小
  objSelection.TypeText（mArray（i））
  objSelection.TypeParagraph
  Next
  End Sub
  

  注意：我也可以从 https://msdn.microsoft.com/zh-cn/library/office/aa211953%28v=office.11​​%29.aspx 解释如何在不改变选择的情况下查找：
  
  

    With ActiveDocument.Content.Find 
   .Text = blue
   .Forward = True 
   .Execute 
  如果.Found = Tr ue然后.Parent.Bold = True 
   End With 
    

  从这里开始：仅查找样式标题1的文本（Range.Find匹配样式）

  
  

  I am looking for a way to create a new document containing all the text with a specific format from my document.

  See below for what I wrote so far, but I'm stuck here:

  • how do I stop my loop when end of document is reached? or how do I add intelligence to my code to avoid a static loop, and rather do a "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
  

  解决方案

  Thanks to Cindy's nice tip (I could also have found relevant information in Loop through Word document, starting from beginning of file at start of each loop), and in case this could help someone some day:

  1. define the format you are looking for thanks to Word's Macro Recorder

  2. position yourself at the beginning of your document

  3. Use a while loop checking wdFindStop -- It also demonstrate how to use Array of String in 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
  

  NB: I could also have greatly benefited from https://msdn.microsoft.com/en-us/library/office/aa211953%28v=office.11%29.aspx that explains how to find without changing the selection:

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

  And from here: Find text only of style "Heading 1" (Range.Find to match style)

  这篇关于查找以给定颜色格式化的所有文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！