Boucle sur des zones de texte

Bonsoir à toutes et tous,

Question d'ordre général (raison pour laquelle je ne joins pas de fichier), dans une feuille qui contiendrait plusieurs zone de texte avec un nom différent les un des autres. Est-il possible de créer une boucle qui interrogerait chaque zone de texte ?

Merci ;)

Oui.

Bonjour optimix,

Merci pour votre retour, est-il possible d'avoir un coup de main pour savoir comment y parvenir ?

Bonjour à tous,

Un truc du genre...

Sub test()
 Dim Obj As Shape
  With Sheets("Feuil1") 'nom à adapter
   For Each Obj In ActiveSheet.Shapes
    If Obj.Type = msoTextBox Then
     'ton code
    End If
   Next Obj
  End With
End Sub

Mais sans fichier, réponse hasardeuse...

Cordialement,

Re xorsankukai,

Merci pour votre retour.

Pour ceux que ça peux intéresser, je joins l'adaptation de votre code. Elle est vraiment particulière à mon cas, mais bon, c'est t'on jamais ;) :

Sub redimension()
Dim Obj As Shape
Dim rdv_double As Boolean
Dim nom_cellule, zone_recherche, valeur_recherche As String
Dim plage, add As Range
Dim haut, bas, col, i, z As Long
Dim Position_nom As Long

        With ActiveSheet
            For Each Obj In ActiveSheet.Shapes
                If Obj.Type = msoTextBox Then

                        nom_cellule = Obj.TopLeftCell
                            Set plage = Range("E2:I39")
                            Set add = plage.Find(nom_cellule, LookIn:=xlValues, LookAt:=xlWhole)
                        haut = add.Row '1ère ligne de la zone de texte
                        col = add.Column 'colonne de la zone de texte

                    For i = haut To 38
                        zone_recherche = Cells(i, col)
                        valeur_recherche = nom_cellule
                            Position_nom = InStr(1, zone_recherche, valeur_recherche, 1) ' si pas de résultat retourne 0
                                If Position_nom = 0 Then
                                    bas = Cells(i, "col").Row - 1 'dernière ligne de la zone de texte
                                    Exit For
                                End If
                    Next i

                    For z = haut To bas
                        If Cells(z, col) Like "*/*" Then
                            rdv_double = True
                            Exit For
                        End If
                    Next z
                        If rdv_double = False And Obj.Width <> Columns(col).Width - 2 Then Obj.Width = Columns(col).Width - 2
                End If
            Next Obj
        End With

End Sub

A + ;)