查找和替换普通文本和超链接显示文本的组合

Find and replace combination of normal text and hyperlink display text

如何找到部分位于超链接内部和外部的字符串?

示例:我想用水平线替换下图中突出显示的字符串:

正常替换代码找不到字符串,因为下划线部分是超链接,其余部分不是。

Sub C___String_ReplaceWithLine_Recorded_NW()

'create and cut a line to put it into the clipboard for replace box
    selection.EndKey Unit:=wdLine
    selection.InlineShapes.AddHorizontalLineStandard
    selection.MoveRight Unit:=wdCharacter, Count:=1 'moves to end of line
    selection.MoveLeft Unit:=wdCharacter, Count:=1 'selects the line
    
    selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    selection.Cut 'cut the line
    selection.TypeBackspace 'remove the CR added when line inserted

'replace the text with the line - NW - NOT FOUND - won't find strings partly hyperlink
    selection.Find.ClearFormatting
    selection.Find.Replacement.ClearFormatting
    With selection.Find
        .text = "Add a comment ^13" 'WONT FIND IF PART IS HYPERLINK
        .Replacement.text = "^c"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With

End Sub

您的问题只是您的宏无法运行。原因如下:

在你运行你的宏之前你select你想要查找的文档区域。

您 运行 宏,它做的第一件事是 更改 selected.

当宏达到 Selection.Find.ClearFormatting 时,实际上什么都没有 selected。当光标显示为插入点时,您可以在屏幕上非常清楚地看到这一点。

这只是您在 VBA 中编写代码时应避免使用 Selection 对象的众多原因之一。

您可以使用类似于以下代码的方法解决此问题:

Sub String_ReplaceWithLine()
    
    CreateLineAndMoveToClipboard
    ReplaceHyperlinks "Add a comment"
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "Add a comment ^p"
        .Replacement.Text = "^c"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
    
End Sub

Sub CreateLineAndMoveToClipboard()
    Dim line As InlineShape
    With ActiveDocument
        Set line = .Characters.Last.InlineShapes.AddHorizontalLineStandard(.Characters.Last)
        line.Range.Cut
        .Characters.Last.Delete
    End With
End Sub

Sub ReplaceHyperlinks(displayText As String)
    Dim index As Long
    With ActiveDocument
    'as you are deleting hyperlinks it is necessary to work backwards through the collection
        For index = .Hyperlinks.Count To 1 Step -1
            With .Hyperlinks(index)
                If .TextToDisplay = displayText Then
                    .Range.Paragraphs(1).Range.Paste
                End If
            End With
        Next index
    End With
End Sub