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

Question

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

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 的顺序标记了每个页面。每个页面都有一个 TextBox，其中包含文本“删除此页面”（这是文本宏正在寻找）。

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

谁能提供任何关于为什么它只会删除奇数页的见解？

编辑： 用户 ma​​cropod 极大地帮助了它正常工作。完整的工作宏如下所示：

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 标志是必需的，以确保文档末尾没有空白页如果在最后一页上找到了一个文本框。

Answer 1

你应该向后循环形状；否则循环会在删除后跳过下一个形状。也不需要选择任何东西：

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