☰

使用 Word VBA 查找、复制、移动选择

tag-icon • tag-icon microsoft-word vba
使用 Word VBA 查找、复制、移动选择

我已经尝试了所有方法但它仍然超出了结束书签。

Sub Macro3() 
    Dim rngStart As Range, rngEnd As Range 
    Set rngStart = ActiveDocument.Bookmarks("START").Range 
    Set rngEnd = ActiveDocument.Bookmarks("END").Range 
    Selection.SetRange rngStart.Start, rngEnd.End 
    Do 
        If Selection.Find.Found And Selection.Range.Start < rngEnd.End Then 'do your copy/moves ... 
        Else 
            Exit Sub 
        End If 
    Loop 
End Sub

我有一个文档，其中包含重复的信息，我需要查找并复制/移动到文档末尾。我不希望它搜索已发送到文档底部的内容。我使用了以下代码；但是，一旦到达 END 书签，它就不会停止运行。非常感谢您的帮助。

Sub Macro3()
'
' Macro3 Macro
'

    Dim rngStart As Range, rngEnd As Range
    Set rngStart = ActiveDocument.Bookmarks("START").Range
    Set rngEnd = ActiveDocument.Bookmarks("END").Range

    Selection.SetRange rngStart.Start, rngEnd.End
    Do
        With Selection.Find
            .Forward = True
            .Execute FindText:="Flag"
            Selection.HomeKey Unit:=wdLine
            .Forward = False
            .Execute FindText:="IDR Date"
        End With
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.Copy
        Selection.EndKey Unit:=wdStory
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
        Selection.TypeBackspace
        Selection.TypeText Text:=vbTab
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .Forward = True
            .Execute FindText:="Flag"
        End With
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.Cut
        Selection.EndKey Unit:=wdStory
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
        Selection.HomeKey Unit:=wdStory

        If Selection.Find.Found Then
            With Selection.Find
                .Forward = True
                .Execute FindText:="Flag"
                Selection.HomeKey Unit:=wdLine
                .Forward = False
                .Execute FindText:="IDR Date"
            End With
            Selection.MoveDown Unit:=wdLine, Count:=1
            Selection.HomeKey Unit:=wdLine
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            Selection.Copy
            Selection.EndKey Unit:=wdStory
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
            Selection.TypeBackspace
            Selection.TypeText Text:=vbTab
            Selection.HomeKey Unit:=wdStory
            With Selection.Find
                .Forward = True
                .Execute FindText:="Flag"
            End With
            Selection.HomeKey Unit:=wdLine
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            Selection.Cut
            Selection.EndKey Unit:=wdStory
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
            Selection.HomeKey Unit:=wdStory
        Else
            Exit Do
        End If
    Loop
End Sub

答案1

当到达“结束”书签时，您的代码不会停止运行，因为您没有对其进行任何测试。每次之后：

If Selection.Find.Found then

您需要检查 Found 字符串的起始位置与 End 书签的 End 位置，其格式如下：

If Selection.Find.Found and Selection.Range.Start < rngEnd.End then
       'do your copy/moves
   else
       Exit Sub
End If

相关内容