更改特定文本的颜色并选择它(视觉基础词)Pin

Changing the color of specific text and also selecting it (visual basics word) Pin

Helo,根据这段代码(In Visual Basic for word): 该代码对我有用,但这不是我想要的...

问题是:我只习惯 select 彩色文本(示例 -> 红色文本),select 将所有红色文字着色。 我很沮丧,因为我已经尝试了一切,但它对我不起作用。 例如,我的目标是 select 只有我的原则文档中的蓝色文本或红色文本。 我在文档中使用的颜色很简单;红色、蓝色、绿色、白色、白色,最重要的文字是天蓝色。 抱歉写信,谢谢你的麻烦。

//替换文字颜色//

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

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

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