VBA Powerpoint: Supprimer la forme avec un texte spécifique. Erreur d'exécution '-2147024809 (80070057)': La valeur spécifiée est en dehors de la plage

Question

J'ai une très longue présentation de ppt (environ 850 diapos) et la seconde moitié est pleine de formes avec certains textes que je voudrais supprimer . Malheureusement, il semble que cela n'a rien à voir avec le Slide Master, donc je ne peux pas l'utiliser.

J'ai eu une erreur:

Run-time error '-2147024809 (80070057)': 
The specified value is out of range 

Voici le code, je suis arrivé au moment

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 

End Sub

Answer 1

Il y a plusieurs raisons de ce code pourrait soulever une erreur. Premièrement, si la diapositive 335 ou la forme 4 n'existe pas (essayez de rendre ces nombres dynamiques ou de gérer les erreurs). Ensuite, votre ligne If évaluera les deux parties, donc si la forme n'a pas de TextFrame, VBA essayera toujours d'évaluer la seconde partie et donc de générer une erreur. Enfin, vous devez également compter à rebours dans toute collection d'objets que vous pouvez supprimer des objets. Vous pouvez également simplifier en utilisant la pour chaque construction suivante et passez en option le texte de recherche à la procédure de votre code principal:

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 

Si vous voulez rendre le texte de recherche dynamique, c'est une méthode simple et agréable. Il suffit de remplacer le Si SSEARCH = "" ... ligne avec ceci:

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") 

Answer 2

@JamieG Merci, j'ai trouvé les mêmes solutions (mais pas aussi propre que votre code). J'allais le publier quand j'ai vu votre réponse

Vive

EDIT: Plus de précision: Le réglage dynamique de la chaîne était un peu difficile (ma connaissance de VBA est pas très avancé). Pour cette raison, il était beaucoup plus facile pour moi de sélectionner le texte dans une certaine diapositive/forme. Le commentaire sur IF était sur le point, ainsi que le comptage arrière lors de la suppression