Grouper à partir d'une forme

Bonjour à tous !

Je bricole un code permettant de simplifier la vie des utilisateurs de mon fichier en permettant de grouper et dégrouper des lignes sans utiliser le "+" et "-" via des formes.

Le code à l'heure actuelle ressemble à ça :

Sub GrouperDégrouper()
    Dim rowExpanded As Boolean

rowExpanded = Rows(3).ShowDetail
If rowExpanded = True Then
    ActiveSheet.Protect , userinterfaceonly:=True
    Rows(3).ShowDetail = False

'Modification des propriétés de la forme Ovale
    ActiveSheet.Shapes.Range(Array("Oval 1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Voir les activités du métier"

    With Selection.ShapeRange.Fill
        .ForeColor.RGB = RGB(146, 208, 80)
    End With
    Range("A1").Activate

Else
    ActiveSheet.Protect , userinterfaceonly:=True
    Rows(3).ShowDetail = True

'Modification des propriétés de la forme Ovale
    ActiveSheet.Shapes.Range(Array("Oval 1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Réduire les activités du métier"

    With Selection.ShapeRange.Fill
        .ForeColor.RGB = RGB(255, 192, 0)
    End With
    Range("A1").Activate
End If
End Sub

Les petits soucis sont :

• j'ai énormément de shapes auxquelles je dois affecter cette macro.
• il est possible d'insérer des lignes supplémentaires dans les groupes rendant les index de mes Rows incorrects.

Je me demandais, après modification, s'il n'était pas possible d'affecter le même code à l'ensemble de mes formes.

Pour cela il faudrait que je parvienne à rendre dynamiques les index de mes Rows en fonction de la position du Shape

J'ai cherché du coté de l'objet Shape afin de voir s'il était possible de lui affecter un Activate mais a priori cela n'existe pas

En résumé, la Shape correspondante à un groupe doit pouvoir ouvrir et fermer le groupe en utilisant le même code pour toutes les Shapes. Est ce possible?

Pas facile à expliquer, je vous propose un fichier en pièce jointe

PS : La protection de la feuille n'a pas de code, il suffit de l'ôter

Bonjour

Remplaces ta macro par celle-ci

Sub GrouperDégrouper()
Dim rowExpanded As Boolean
Dim Sh As Shape

  ActiveSheet.Protect , userinterfaceonly:=True
  Set Sh = ActiveSheet.Shapes(Application.Caller)
  rowExpanded = Rows(Sh.TopLeftCell.Row).ShowDetail
  If rowExpanded = True Then
    Rows(Sh.TopLeftCell.Row).ShowDetail = False

    'Modification des propriétés de la forme Ovale
    Sh.TextFrame.Characters.Text = "Voir les activités du métier"
    Sh.Fill.ForeColor.RGB = RGB(146, 208, 80)
  Else
    Rows(Sh.TopLeftCell.Row).ShowDetail = True

    'Modification des propriétés de la forme Ovale
    Sh.TextFrame.Characters.Text = "Réduire les activités du métier"
    Sh.Fill.ForeColor.RGB = RGB(255, 192, 0)
  End If
End Sub

Bonjour,

C'est parfait, comme d'habitude, un grand merci! Je vais étudier les modifications.

Bonne journée