试图在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标记了每个页面。每个页面都有一个文本框，其中包含"删除此页面"的文本。(这是宏正在寻找的文本)。

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

谁能解释一下为什么它只删除奇数页?

编辑:用户macropod是一个巨大的帮助，让这个工作正确。完整的宏如下所示:

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