Macro bizarre !!!

[mromain]

Bonjour le forum...

Je suis coincé sur une macro et je n'arrive pas à trouver d'ou vient le problème.
Ma macro parcoure toutes les feuilles du fichier, dans chaque feuille, on parcour tous les Shapes, et on teste si ils contiennent le texte "toto".

jusque là, pas de soucis...

J'ai eut un problème en rajoutant on objet "WordArt". 🙁
La macro "buge" à la ligne

If curShape.TextFrame.Characters(Start:=1, Length:=Len(texteRecherche)).Text = texteRecherche Then

.

Problème résolu en ajoutant un filtre sur le type de Shape 🙂

If Not (curShape.Type = msoAutoShape) Then GoTo suite

Ensuite, j'ai eut un problème en rajoutant une accolade (qui est un shape également de type "msoAutoShape"...) 🙁
Pour passer outre cette erreur, j'ai rajouté :

On Error GoTo suite

ça fonctionne. 🙂

Mais, si il y a plus de une accolade par feuille, la macro "buge". 🙁🙁🙁🙁

Et là, vraiment je bloque...


Si quelqu'un à une idée pour résoudre mon PB, je suis plus que preneur...

A+


PS: le fichier est en PJ

 

[Spitnolan08]

Re : Macro bizarre !!!

Bonjour,

je n'ai pas de réponse satisfaisante à t'apporter mais une solution pour éviter ton bug (Nota, tu peux laisser ton goto sortie au lieu de Goto 1)

If Not curShape.Type = msoAutoShape Then GoTo 1
         On Error Resume Next
         ' si le contenu du shape parcouru commence par "texteRecherché"
         If curShape.TextFrame.Characters(Start:=1, Length:=Len(texteRecherche)).Text = texteRecherche Then
             Set shapeRecherche = curShape    'récupérer le shape
             isShape = True  'préciser qu'on a trouvé un shape
         
         End If

1    Next curShape

Cordialement

 

[Pierrot93]

Re : Macro bizarre !!!

Bonjour Romain, Spitnolan🙂


essaye peut être comme ceci, en utilisant la propriété "AlternativeText", à voir si cela fonctionne avec tous les types d'objet...

For Each curSheet In ThisWorkbook.Sheets    'parcourir toutes les feuilles
    isShape = False     ' on par du principe qu'il n'y a pas de shape contenant "toto" dans la feuille
    For Each curShape In curSheet.Shapes 'parcourir tous les shape de la feuille actuelle
         If curShape.AlternativeText <> "" And curShape.Type = msoAutoShape Then
            If curShape.TextFrame.Characters(Start:=1, Length:=Len(texteRecherche)).Text = texteRecherche Then
                Set shapeRecherche = curShape    'récupérer le shape
                isShape = True  'préciser qu'on a trouvé un shape
            End If
         End If
    Next curShape   'passer au prochain shape de la feuille
    If isShape Then     'si on à trouvé le shape (si "isShape" = True)
    'Remarque: on pourait écrire "If isShape = True Then"
'Tu peux ici faire ce que tu veux de ton shape. si j'ai bien compris, tu veux changer la macro affectée à ce shape,
'je crois que c'est ça :
'''''   shapeRecherche.OnAction = "la_macro_a_affecter"
        'afficher dans une "MessageBox"
        MsgBox ("feuille: " & curSheet.Name _
        & vbNewLine _
        & "nom du shape contenant """ & texteRecherche & """: " & shapeRecherche.Name)
        '- "feuille: <nom de la feuille courante>"
        '- retour à la ligne
        '- "nom du shape contenant "<texteRecherché>": <nom du Shape courante>
        
    Else    'sinon
        'afficher dans une "MessageBox" : "pas de shape contenant "<texteRecherché>" dans la feuille: <nom de la feuille courante>"
        MsgBox ("Il n'ypas de shape contenant """ & texteRecherche & """ dans la feuille: " & curSheet.Name)
    End If
Next curSheet   'passer à la prochaine feuille du classeur

bon après midi
@+

 

[mromain]

Re : Macro bizarre !!!

Bonjour Spitnolan08 et Pierrot93.

Merci pour vos réponses rapides.
En faisant un petit mix de vos deux solutions, je suis arrivé à mes fins.
Je met mon fichier corrigé en PJ pour les intéressé.


Merci encore et longue vie à ce forum...


A+