时间戳

首页 > 解决方案 > Word VBA Find and move on

vba - Word VBA Find and move on

问题描述

Here is my issue, I'm looking for ":" and typing HTML code with VBA. The code below keeps looping at the same ":" and does not move on to the next, since I'm not actually removing it. Any suggestions?

Dim bFound As Boolean


bFound = True
Set r = ActiveDocument.Content

r.Find.ClearFormatting
Do While bFound
    With r.Find
        .Text = ":"
        .Replacement.Text = ":</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute(Replace:=wdReplaceOne, Forward:=True)
    End With

    If bFound Then
        r.Select
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:="<b>"
        Selection.EndKey Unit:=wdLine
        Selection.MoveRight
    End If
Loop

标签： vbams-wordfind-replace

解决方案

代码有两个问题，否则很好：

  1. 它wdFindContinue用于Wrap属性，这意味着 Find 将在文档开头重新启动。根据经验，始终wdFindStop在代码中使用。

  2. 如果正在搜索的内容保留在文档中，则有必要将找到的 Range 移动到该点之外。这可以通过使用来完成Range.Collapse。可以将其想象为当您进行选择时按键盘上的右箭头键：它将光标置于所选内容之外。

我已经用这两个更改修改了原始代码，另外我还声明了一个Range变量。没有此声明的原始代码运行表明Option Explicit可能不在代码模块的顶部。如果有就更好了...

Sub JumpBeyondFound()
    Dim r As Word.Range
    Dim bFound As Boolean

    bFound = True
    Set r = ActiveDocument.content

    r.Find.ClearFormatting
    Do While bFound
        With r.Find
            .Text = ":"
            .Replacement.Text = ":</b>"
            .Forward = True
            .wrap = wdFindStop
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            bFound = .Execute(Replace:=wdReplaceOne, Forward:=True)
        End With

        If bFound Then
            r.Select
            Selection.HomeKey Unit:=wdLine
            Selection.TypeText Text:="<b>"
            Selection.EndKey Unit:=wdLine
            Selection.MoveRight
            r.Collapse wdCollapseEnd
        End If
    Loop
End Sub

推荐阅读