특정 색상으로 강조 표시된 텍스트 찾기 및 수정

하이라이트 색상을 식별하기 위해 필요한 것은 속성 Range.HighlightColorIndex입니다.

아래 코드를 다소 간소화했습니다.

1. 문서의 시작 부분에서 검색이 시작되는지 확인했습니다 (필요하지 않은 경우 제거 / 주석 처리 할 수 ​​있지만 테스트 중에 문제가 발생하지 않음). Selection.HomeKey wdStory

2. .Wrap처음부터 끝까지 검색을 실행하는 것이 일반적이므로 'wdFindStop'으로 설정 합니다. 다시 말하지만, 문서 시작 부분에서 다시 시작하라는 메시지를 명시 적으로 표시하려는 경우 다시 변경할 수 있습니다.

3. 성공 flag여부를 테스트하기 위해 사용 방법 이 변경 Find.Execute되었습니다. 이 메서드는 true성공하면 반환 하고 그렇지 않으면를 반환 합니다 false. 선택 항목에 밑줄이 있는지 여부를 테스트하는 것은 마지막 성공 Find항목에 밑줄이 표시되고 아무것도 발견되지 않으면 선택 항목이 이동 하지 않기 때문에 신뢰할 수 없습니다.

4. 검색이 성공하고 발견 된 밑줄이있는 텍스트가 청록색으로 강조 표시되면 수정 조작이 수행됩니다.

나는 또한 While...Wend새로운 Do...Loop구조로 더 이상 사용되지 않는을 변경했습니다 . 이것은 루핑 테스트를 구성하는 방법에서 훨씬 더 유연합니다.

Sub Redact()

    ' Redact Macro
    ' Macro to redact underlined text
    ' If redacted, text will be replaced by x's, coloured black and highlighted black

    Dim OldText, OldLastChar, NewLastChar, NewText, ReplaceChar As String
    Dim RedactForm As Integer
    Dim flag As Boolean

    Application.ScreenUpdating = False

    ReplaceChar = "x"

    'Make sure to start at the beginning of the document
    Selection.HomeKey wdStory
    Do

        ' Find next underline with highlight
        Selection.Find.ClearFormatting
        Selection.Find.Font.Underline = wdUnderlineSingle
        Selection.Find.Highlight = True
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = ""
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With

        flag = Selection.Find.Execute

        If flag Then
            If Selection.Range.HighlightColorIndex = wdTurquoise Then
                ' Create replacement string
                ' If last character is a carriage return (unicode 13), then keep that carriage return
                OldText = Selection.Text
                OldLastChar = Right(OldText, 1)
                NewLastChar = ReplaceChar
                If OldLastChar Like "[?*#]" Then NewLastChar = String(1, 13)
                NewText = String(Len(OldText) - 1, ReplaceChar) & NewLastChar

                ' Replace text, black block
                Selection.Text = NewText
                Selection.Font.ColorIndex = wdBlack
                Selection.Font.Underline = False
                Selection.Range.HighlightColorIndex = wdBlack
                Selection.Collapse wdCollapseEnd
            End If
        End If

    Loop While flag

    Application.ScreenUpdating = True

End Sub