XL 2013 boucler sur les shapes d'une feuille y compris les shapes inclus dans un groupe

[gvives]

Bonjour à tous,

J'ai un petit soucis sur l'un de mes codes VBA.

J'ai une feuille qui intègre plusieurs shapes dont un groupe nommé "Groupeattachement" contenant un shapes qui prend un nom variable commençant systématiquement par "adresse!" + un numéro variable.

Je souhaiterai boucler sur les shapes contenus dans la feuille active et dès que ce shapes commence par "adresse" récupérer le numéro variable. Le soucis c'est que ma boucle ne boucle que sur le groupe et pas sur les shapes qu'il contient.

Voici mon code :

Dim Sh As shape

For Each Sh In ActiveWorkbook.ActiveSheet.Shapes

If Mid(Sh.Name, 1, 7) = "adresse" Then

nomadresse = Mid(Sh.Name, InStrRev(Sh.Name, "!") + 1, Len(Sh.Name))

End If

Next Sh

Merci d'avance à tous si vous avez une solution et très bonne soirée !!

 

[mapomme]

Re : boucler sur les shapes d'une feuille y compris les shapes inclus dans un groupe

Bonsoir gvives,

Un essai dans le fichier joint (sous Excel 10). On utilise l'objet GroupItems de chaque shape (qui n'existe que si le shape est un groupe d'où l'utilisation de la détection d'erreur). GroupItems est l'ensemble des formes de base contenues dans un groupe.
Cliquer sur le bouton noir.

Code dans le module de Feuil1:

Sub test()
Dim shx As Shape, i&, n&

  Range("a15:a99").ClearContents: Range("a15").Select
  On Error Resume Next
  For Each shx In Me.Shapes
    n = shx.GroupItems.Count
    If Err.Number = 0 Then
      For i = 1 To n
        ActiveCell = shx.GroupItems(i).Name
        ActiveCell.Offset(1).Select
      Next i
    Else
      Err.Clear
      ActiveCell = shx.Name
      ActiveCell.Offset(1).Select
    End If
  Next shx
  On Error GoTo 0
End Sub

 

[gvives]

Re : boucler sur les shapes d'une feuille y compris les shapes inclus dans un groupe

Merci beaucoup,

Exactement ce que je voulais c'est super !

Très bonne journée mapomme !

 

[mapomme]

Re : boucler sur les shapes d'une feuille y compris les shapes inclus dans un groupe

Bonjour gvives,

Le code de la version v1 impliquait de dupliquer le code à exécuter pour chaque forme selon que la forme était une forme de base ou bien un groupe de formes de base.

Cette version v2 permet de n'écrire qu'une seule fois le code à exécuter pour chaque forme de base.

On procède en deux étapes:

1[SUP]ère[/SUP] étape:
Pour une forme donnée, on construit une collection:

• si la forme est une forme de base, la collection ne comprendra qu'une seule forme (la forme elle-même)
• si la forme est un groupe, la collection comprendra toutes les formes de base du groupe

2[SUP]ème[/SUP] étape:
on boucle sur l’ensemble des formes de la collection (créée à l'étape n°1) pour dérouler le code à exécuter pour chaque forme de base

Pour la v2:

Sub Test1()
Dim shx As Shape, shy As Shape, shxShapes As Object

Range("a15:a99").ClearContents: Range("a15").Select

For Each shx In Me.Shapes
  Set shxShapes = Nothing
  On Error Resume Next: Set shxShapes = shx.GroupItems: On Error GoTo 0
  If shxShapes Is Nothing Then
    Set shxShapes = New Collection: shxShapes.Add shx
  End If
  
  For Each shy In shxShapes
    ActiveCell = shy.Name: ActiveCell.Offset(1).Select
  Next shy
Next shx
  
End Sub

Dans le fichier v2, le code est commenté.