VBA Powerpoint:删除带有特定文本的形状。 运行-time error '-2147024809 (80070057)': 指定值超出范围
VBA Powerpoint: Delete Shape with specific text. Run-time error '-2147024809 (80070057)': The specified value is out of range
我有一个很长的 ppt 演示文稿(大约 850 张幻灯片),后半部分充满了形状和我想删除的某些文本。遗憾的是,它似乎与 Slide Master 无关,所以我无法使用它。
我收到一个错误:
Run-time error '-2147024809 (80070057)':
The specified value is out of range
这是我目前得到的代码
Sub DeleteShapeWithSpecTxt()
Dim oSl As Slides, oSh As Shapes, oTr As TextRange
Dim str As String
Dim testcomp1, testcomp2
Dim lppt, ShapeNb, k, j As Long
Dim pptAct
Set pptAct = PowerPoint.ActivePresentation
str = pptAct.Slides(335).Shapes(4).TextFrame.TextRange.Text
lppt = pptAct.Slides.Count
For k = 1 To lppt
ShapeNb = pptAct.Slides(k).Shapes.Count
For j = 1 To ShapeNb
If pptAct.Slides(k).Shapes(j).HasTextFrame And StrComp(str, pptAct.Slides(k).Shapes(j).TextFrame.TextRange.Text) = 0 Then
pptAct.Slides(k).Shapes(j).Delete
End If
Next
Next
结束子
此代码可能引发错误的原因有多种。首先,如果幻灯片 335 或形状 4 不存在(尝试使这些数字动态化或处理错误)。接下来,您的 If 行将评估两个部分,因此如果形状没有 TextFrame,VBA 仍将尝试评估第二部分并因此引发错误。最后,您还需要在任何对象集合中倒数您可能删除的对象。您还可以使用 For Each Next 构造简化此过程,并可选择将搜索文本从主代码传递给过程:
Sub DeleteShapeWithSpecTxt(Optional sSearch As String)
Dim oSld As Slide
Dim oShp As Shape
Dim lShp As Long
On Error GoTo errorhandler
If sSearch = "" Then sSearch = ActivePresentation.Slides(335).Shapes(4).TextFrame.TextRange.Text
For Each oSld In ActivePresentation.Slides
' I would usually use the next line to loop through all shapes on the slide but can't in this case as shapes may be deleted
'For Each oShp In oSld.Shapes
For lShp = oSld.Shapes.Count To 1 Step -1
With oSld.Shapes(lShp)
If .HasTextFrame Then
If StrComp(sSearch, .TextFrame.TextRange.Text) = 0 Then .Delete
End If
End With
Next
Next
Exit Sub
errorhandler:
Debug.Print "Error in DeleteShapeWithSpecTxt : " & Err & ": " & Err.Description
On Error GoTo 0
End Sub
如果您想让搜索文本动态化,这是一个不错的简单方法。只需将 If sSearch = ""... 行替换为:
If sSearch = "" Then sSearch = InputBox("Enter test to search for and all shapes matching the text will be deleted across this presentation:","Delete Matching Shapes","test")
@JamieG 谢谢,我找到了相同的解决方案(但不如您的代码整洁)。当我看到你的回答时,我正打算 post 它
干杯
编辑:更精确:字符串的动态设置有点困难(我对 VBA 的了解不是很深)。因此,select 某个 slide/shape 中的文本对我来说要容易得多。
IF评论说的很到位,删除时倒数
我有一个很长的 ppt 演示文稿(大约 850 张幻灯片),后半部分充满了形状和我想删除的某些文本。遗憾的是,它似乎与 Slide Master 无关,所以我无法使用它。
我收到一个错误:
Run-time error '-2147024809 (80070057)':
The specified value is out of range
这是我目前得到的代码
Sub DeleteShapeWithSpecTxt()
Dim oSl As Slides, oSh As Shapes, oTr As TextRange
Dim str As String
Dim testcomp1, testcomp2
Dim lppt, ShapeNb, k, j As Long
Dim pptAct
Set pptAct = PowerPoint.ActivePresentation
str = pptAct.Slides(335).Shapes(4).TextFrame.TextRange.Text
lppt = pptAct.Slides.Count
For k = 1 To lppt
ShapeNb = pptAct.Slides(k).Shapes.Count
For j = 1 To ShapeNb
If pptAct.Slides(k).Shapes(j).HasTextFrame And StrComp(str, pptAct.Slides(k).Shapes(j).TextFrame.TextRange.Text) = 0 Then
pptAct.Slides(k).Shapes(j).Delete
End If
Next
Next
结束子
此代码可能引发错误的原因有多种。首先,如果幻灯片 335 或形状 4 不存在(尝试使这些数字动态化或处理错误)。接下来,您的 If 行将评估两个部分,因此如果形状没有 TextFrame,VBA 仍将尝试评估第二部分并因此引发错误。最后,您还需要在任何对象集合中倒数您可能删除的对象。您还可以使用 For Each Next 构造简化此过程,并可选择将搜索文本从主代码传递给过程:
Sub DeleteShapeWithSpecTxt(Optional sSearch As String)
Dim oSld As Slide
Dim oShp As Shape
Dim lShp As Long
On Error GoTo errorhandler
If sSearch = "" Then sSearch = ActivePresentation.Slides(335).Shapes(4).TextFrame.TextRange.Text
For Each oSld In ActivePresentation.Slides
' I would usually use the next line to loop through all shapes on the slide but can't in this case as shapes may be deleted
'For Each oShp In oSld.Shapes
For lShp = oSld.Shapes.Count To 1 Step -1
With oSld.Shapes(lShp)
If .HasTextFrame Then
If StrComp(sSearch, .TextFrame.TextRange.Text) = 0 Then .Delete
End If
End With
Next
Next
Exit Sub
errorhandler:
Debug.Print "Error in DeleteShapeWithSpecTxt : " & Err & ": " & Err.Description
On Error GoTo 0
End Sub
如果您想让搜索文本动态化,这是一个不错的简单方法。只需将 If sSearch = ""... 行替换为:
If sSearch = "" Then sSearch = InputBox("Enter test to search for and all shapes matching the text will be deleted across this presentation:","Delete Matching Shapes","test")
@JamieG 谢谢,我找到了相同的解决方案(但不如您的代码整洁)。当我看到你的回答时,我正打算 post 它
干杯
编辑:更精确:字符串的动态设置有点困难(我对 VBA 的了解不是很深)。因此,select 某个 slide/shape 中的文本对我来说要容易得多。 IF评论说的很到位,删除时倒数