VBA Word 宏根据 Word 文档中的字体颜色匹配预先添加文本

Question

我正在尝试在 Microsoft Word 中创建一个 VBA 宏，它将：

1. 首先选择用作“颜色键”的文本。选择中的每一行都有唯一的颜色和文本字符串。

2. 存储所选内容中每行的字体颜色和文本。

3. 在文档的其余部分搜索字体颜色与“颜色键”选择中的任何颜色相匹配的段落。

4. 将颜色键中的匹配文本添加到共享相同字体颜色的任何段落之前。

如果选择了三行并运行了宏，则预期输出应该是这样的。

代码，我已经尝试过

Sub ApplyColorKeyPrefixes()

    Dim doc As Document
    Dim selectedRange As Range
    Dim colorKeyColors As Collection
    Dim colorKeyPrefixes As Collection
    Dim para As Paragraph
    Dim line As Range
    Dim colorCode As Long
    Dim prefixText As String
    Dim i As Long

    ' Initialize document and collections for color key
    Set doc = ActiveDocument
    Set colorKeyColors = New Collection
    Set colorKeyPrefixes = New Collection
    Set selectedRange = Selection.Range

    For i = 1 To selectedRange.Paragraphs.Count
        Set line = selectedRange.Paragraphs(i).Range
        line.End = line.End - 1  ' Exclude paragraph mark

        ' Store the color and corresponding text
        colorCode = line.Font.Color
        prefixText = Trim(line.Text)

        On Error Resume Next
        colorKeyColors.Add colorCode, CStr(colorCode)
        colorKeyPrefixes.Add prefixText, CStr(colorCode)
        On Error GoTo 0
    Next i

    'oop through all paragraphs in the document (after selection) to find matches
    For Each para In doc.Paragraphs
        ' Skip paragraphs in the initial selection
        If para.Range.Start >= selectedRange.End Then
            Set line = para.Range.Words(1)  ' use first text of selection to determine color
            colorCode = line.Font.Color
            
            ' Check if color match in parag
            On Error Resume Next
            prefixText = colorKeyPrefixes(CStr(colorCode))
            On Error GoTo 0

            If prefixText <> "" Then
                para.Range.InsertBefore prefixText & ": "
                
                ' Retain color for the og text and the prefix text
                para.Range.Words(1).Font.Color = colorCode
                para.Range.Font.Color = colorCode
            End If
        End If
    Next para

    Set colorKeyColors = Nothing
    Set colorKeyPrefixes = Nothing

End Sub

问题 该代码当前正在将前缀应用于所有段落，而不仅仅是具有匹配字体颜色的段落。我怀疑我在 colorKeyPrefixes 中检查字体颜色匹配的方式可能存在问题，但我不确定问题出在哪里。

如何修改宏，以便它仅将前缀文本附加到与所选“颜色键”中的行之一具有相同字体颜色的段落？

补充说明 选择中的每一行保证只有一种颜色。 颜色键最多可以包含 12 种不同的颜色。 我使用每个段落的第一个单词来检查颜色（假设颜色适用于整个段落）。

Answer 1

解决此问题的更好方法是将操作分为两个过程，并使用

Find

获取适用的段落，而不是爬行段落集合。

Sub ApplyColorKeyPrefixes()

Dim para As Paragraph, keyRange As Range
Dim startFind As Long

startFind = Selection.Range.End + 1

For Each para In Selection.Paragraphs
    Set keyRange = para.Range
    keyRange.MoveEnd wdCharacter, -1
    FindandApplyColorKey startFind, keyRange.Font.Color, keyRange.Text & " "
Next

End Sub

Private Sub FindandApplyColorKey(rngStart As Long, textColor As Long, prefixText As String)
    Dim findRange As Range
    Set findRange = ActiveDocument.Content
    With findRange
        .Start = rngStart
        With .Find
            .ClearFormatting
            .Format = True
            .Forward = True
            .Wrap = wdFindStop
            .Text = ""
            .Font.Color = textColor
        End With
        Do While .Find.Execute
            .InsertBefore prefixText
        Loop
    End With
End Sub