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评论说的很到位,删除时倒数