尝试删除 Microsoft Word (VBA) 中包含文本框中特定文本的页面

问题描述

我一直在使用 VBA 为 Microsoft Word 开发一个宏，它应该在文本框(形状)中找到某些文本，然后删除包含该文本的文本框所在的页面.这是我的宏:

I have been developing a macro for Microsoft Word using VBA which is supposed to find certain text within a textbox (shape) and then delete the page that the textbox with that text is found on. Here is my macro:

Sub DeletePagesWithSpecificTextBoxText()
    Dim shp As Shape
    Dim FoundOnPageNumber As Integer

    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            shp.Select
            With Selection.Find
                .ClearFormatting
                .Text = "delete this page"
                .Forward = True
                .Wrap = wdFindContinue
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Execute
                If .Found Then
                    FoundOnPageNumber = Selection.ShapeRange.Anchor.Information(wdActiveEndPageNumber)
                    Selection.GoTo wdGoToPage, wdGoToAbsolute, FoundOnPageNumber
                    ActiveDocument.Bookmarks("\Page").Range.Delete
                End If
            End With
        End If
    Next
End Sub

为了测试这个宏 - 我有一个基本的十页文档，我在其中按从 1 到 10 的顺序标记了每个页面.每个页面都有一个包含文本删除此页面"的文本框；(这是宏要查找的文本).

In order to test this macro - I have a basic ten page document where I have labelled each page in sequence from 1 to 10. Each page has a TextBox which contains the text "delete this page" (this is the text the macro is looking for).

宏运行后，文档包含所有偶数页(即 2、4、6、8 和 10)，但奇数页(1、3、5、7 和 9)已被删除.

After the macro has been run, the document contains all of the even pages (i.e. 2, 4, 6, 8 and 10) however the odd pages (1, 3, 5, 7 and 9) have been deleted.

任何人都可以深入了解为什么它只会删除奇数页?

Can anyone provide any insight into why it would only be deleting the odd pages?

用户 ma​​cropod 为使其正常工作提供了巨大帮助.完整的工作宏如下所示:

User macropod was a huge help in getting this to work correctly. The complete working macro is shown below:

Sub DeletePagesWithSpecificTextBoxText()

    Dim TextFoundOnThisPage As Integer
    Dim DeleteLastPage As Boolean

    Application.ScreenUpdating = False

    Dim s As Long
    With ActiveDocument
        For s = .Shapes.Count To 1 Step -1
            With .Shapes(s)
                If .Type = msoTextBox Then
                    If InStr(.TextFrame.TextRange.Text, "delete this page") > 0 Then
                        TextFoundOnThisPage = .Anchor.Information(wdActiveEndPageNumber)

                        If TextFoundOnThisPage = ActiveDocument.ActiveWindow.Panes(1).Pages.Count And DeleteLastPage = False Then
                            DeleteLastPage = True
                        End If

                        .Delete
                        Selection.GoTo wdGoToPage, wdGoToAbsolute, TextFoundOnThisPage
                        ActiveDocument.Bookmarks("\Page").Range.Delete
                    End If
                End If
            End With
        Next
    End With

    If DeleteLastPage Then
        Selection.GoTo wdGoToPage, wdGoToAbsolute, ActiveDocument.ActiveWindow.Panes(1).Pages.Count
        Selection.TypeBackspace
        Selection.TypeBackspace
    End If

    Application.ScreenUpdating = True

End Sub

DeleteLastPage 标志是必需的，以确保文档末尾没有空白页如果在最后一页上找到了文本框.

The DeleteLastPage flag is required to ensure there isn't a blank page left at the end of the document if a textbox was found on that last page.

推荐答案

你应该向后循环形状；否则循环会在删除后跳过下一个形状.也无需选择任何内容:

You should be looping though the shapes backwards; otherwise the loop skips the next shape after a deletion. There is also no need to select anything:

Sub Demo()
Application.ScreenUpdating = False
Dim s As Long
With ActiveDocument
  For s = .Shapes.Count To 1 Step -1
    With .Shapes(s)
      If .Type = msoTextBox Then
        If InStr(.TextFrame.TextRange.Text, "delete this page") > 0 Then
          .Anchor.Bookmarks("\Page").Range.Delete
        End If
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

这篇关于尝试删除 Microsoft Word (VBA) 中包含文本框中特定文本的页面的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！