更改特定文本的颜色并选择它（视觉基础词）答案

【问题标题】：Changing the color of specific text and also selecting it (visual basics word) Pin更改特定文本的颜色并选择它（视觉基础词）
【发布时间】：2020-11-13 05:10:11
【问题描述】：

Helo，根据这段代码（在 Visual Basic for word 中）：该代码适用于我，但它不是我想要的......

问题是：我只不会选择一个彩色文本（例如 -> 一个红色的文本），选择所有用红色着色的单词。我很沮丧，因为我已经尝试了一切，但它对我不起作用。例如，我的目标是选择我的主要文档中的蓝色文本或红色文本。我在文档中的颜色很简单；红色、蓝色、绿色、白色、whele，最重要的文本以天蓝色着色。很抱歉写作并感谢您的麻烦。

//替换文字颜色//

Sub ChangeColorWithReplace()
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorRed
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = -603914241
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

【问题讨论】：

“我的目标是将彩色文本放到另一个 word 文档中。” - 这是什么意思？要将文本从一个文档复制到另一个文档，还是要将文本剪切并粘贴到新文档中？当您将文本放入新文档时，它只是被全部转储在一个段落中，还是放在单独的段落中，还是需要将文本放置在特定位置？请edit您的问题与答案。
您还需要确认您要查找的文本是红色的，即它的 RGB 值为 255,0,0。如果它使用主题颜色格式化，则需要不同的属性才能找到它。同样，请使用这些附加详细信息编辑您的问题。

标签： vba ms-word

【解决方案1】：

这里有一些代码可以帮助您入门：

Sub CopyRedContent()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
With DocSrc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Format = True
    .Font.Color = RGB(255, 0, 0)
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
  Do While .Find.Execute
    DocTgt.Range.Characters.Last.FormattedText = .FormattedText
    DocTgt.Range.InsertAfter vbCr
    If .Information(wdWithInTable) = True Then
      If .End = .Cells(1).Range.End - 1 Then
        .End = .Cells(1).Range.End
        .Collapse wdCollapseEnd
        If .Information(wdAtEndOfRowMarker) = True Then
          .End = .End + 1
        End If
      End If
    End If
    If .End = ActiveDocument.Range.End Then Exit Do
    .Collapse wdCollapseEnd
  Loop
End With
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub

【讨论】：

谢谢你，我非常感激，我认为这会更容易，但我看不出事情的复杂性......它对我想做的事情有很大帮助。 :) :) :)
它的工作 100% 这个家伙太棒了。谢谢。