Macro pour replier/déplier des lignes groupées

Bonjour le Forum !

J'aimerais pouvoir utiliser une macro….mais je ne sais pas l'écrire.

Voilà la chose :

Dans une feuille Excel, j'ai beaucoup de lignes groupées (voir fichier joint).

A l'état normal, ces lignes sont "repliées" sous la ligne de synthèse.

J'ai fréquemment besoin de déplier un groupe et d'en replier un autre, ce qui peut être assez fastidieux quand on veut en passer beaucoup en revue.

J'aimerais pouvoir faire ça en un clic, grâce à un bouton : chaque clic repliant le groupe déjà déplié, et dépliant le groupe suivant, du haut vers le bas de la feuille (et j'aimerais une 2ème macro pour le faire de bas en haut de la feuille, mais je devrais être capable de la bidouiller à partir de la 1ère).

Si quelqu'un peut m'aider, ça sera cool.

Merci.

Hello,

Benzai64 à fait une macro très bien dans le genre, voir PJ.

Edit:

La version modifié qui fait les lignes :

Sub PLIER_DEPLIER_GROUPEMENT()
'Macro pour déplier et replier les plans de groupement de lignes
'________________________________________________________________________
'1. Déclaration des variables
Dim Sh As Shape 'Définit la variable comme étant un objet graphique
Dim TEXTE As String 'Définit la variable comme étant du texte pour mettre à jour l'icone
'________________________________________________________________________
'2. Définition des variables
Set Sh = ThisWorkbook.ActiveSheet.Shapes(Application.Caller) 'Définition de l'objet graphique
TEXTE = Sh.TextFrame.Characters.Text 'Définition de la variable au contenu du texte en cours
'________________________________________________________________________
   '3. Action Partie 1 : mettre à jour l'icone en fonction de son état pour indiquer action pli ou repli
     If TEXTE = "+" Then
       Sh.TextFrame.Characters.Text = "-" 'Flèche bas en police webding
     Else
       Sh.TextFrame.Characters.Text = "+" 'Flèche haut en police webding
     End If
   '3.E. Gestionnaire de gestion d'erreur
   On Error Resume Next
   '3. Action Partie 2 : Action pli ou repli sur cell en cours pour action sur groupement de ligne uniquement
     Rows(Sh.TopLeftCell.Row).ShowDetail = Not Rows(Sh.TopLeftCell.Row).ShowDetail
'________________________________________________________________________
'E. Gestionnaire de gestion d'erreur
  If Err.Number <> 0 Then
    MsgBox "Le bouton n'est pas placé au niveau du groupement de ligne [+], veuillez l'y déplacer", vbInformation, "Echec du Pli/Repli automatique"
  End If
End Sub
'________________________________________________________________________

Héhé ! Je connais bien la macro de Banzai64 : il l'avait développée en réponse à une question que j'avais postée sur le Forum !

Je ne le remercierai jamais assez : j'en ai mis plein partout dans mes classeurs.

Merci à toi de vouloir m'aider.

Petit problème : j'ai du mal expliquer ma demande, car ta macro ne correspond pas exactement à ce que je veux faire.

Ta macro plie/déplie le groupe de lignes dans lequel elle est placée.

J'ai besoin d'une macro qui déplie successivement chaque groupe de ligne, en repliant au fur et à mesure le dernier groupe déplié...

Si ça t'inspire, ton aide me sera précieuse.

Merci en tous cas.

Bonjour,

Proposition avec une toupie. La dernière position est : tout replié.

Private Sub SpinButton1_Change()
    Const plGroupe As String = "A2:A100" ' plage des noms des groupes
    Dim groupe() As Long, gr As Long, i As Long
    Dim pl As Range, c As Range

    Set pl = Range(plGroupe).SpecialCells(xlCellTypeConstants, xlTextValues)
    If pl Is Nothing Then Exit Sub
    ReDim groupe(0 To pl.Count - 1)
    For Each c In pl
        groupe(i) = c.Row + 1
        i = i + 1
    Next c
    SpinButton1 = Application.Min(UBound(groupe) + 1, SpinButton1)
    For gr = 0 To UBound(groupe)
        If Rows(groupe(gr) + 1).OutlineLevel > 1 Then
            On Error Resume Next
            Rows(groupe(gr) + 1).ShowDetail = (gr = SpinButton1)
            On Error GoTo 0
        End If
    Next gr
End Sub

eric

Magistral !

Merci beaucoup, beaucoup !

------- EDIT

Heu... petit problème dû à ma connaissance insuffisante d'Excel :

J'ai copié ton code dans le code de la feuille.

J'ai créé une toupie avec la boîte à outils Contrôles.

Mais quand je clique sur la toupie, il ne se passe rien, sauf l'apparition de poignées.

Je suppose que je dois associer la toupie à la macro, mais je ne sais pas comment faire....

Petite amélioration : 1ère et dernière position pour 'tout replié'

Private Sub SpinButton1_Change()
    Const plGroupe As String = "A2:A100"    ' plage des noms des groupes
    Dim groupe() As Long, gr As Long, i As Long
    Dim pl As Range, c As Range

    Set pl = Range(plGroupe).SpecialCells(xlCellTypeConstants, xlTextValues)
    If pl Is Nothing Then Exit Sub
    ReDim groupe(0 To pl.Count)
    For Each c In pl
        i = i + 1
        groupe(i) = c.Row + 1
    Next c
    Application.EnableEvents = False
    SpinButton1 = Application.Min(UBound(groupe) + 1, SpinButton1)
    Application.EnableEvents = True
    For gr = 1 To UBound(groupe)
        If Rows(groupe(gr) + 1).OutlineLevel > 1 Then
            On Error Resume Next
            Rows(groupe(gr) + 1).ShowDetail = (gr = SpinButton1)
            On Error GoTo 0
        End If
    Next gr
End Sub

eric

PS: c'est une toupie ActiveX qu'il faut, pas Formulaire

J'ai essayé de copier ta toupie pour la coller dans ma feuille, mais je n'y arrive pas.

Du coup, j'ai essayé de créer la toupie ActiveX dans ma feuille, mais je ne sais pas comment faire

(ou plutot : j'ai trouvé sur internet la marche à suivre dans les versions récentes d'Excel, mais je suis sous 2003).

Comment on fait ça sous 2003 ?

Merci !

Quand tu insères un contrôle tu as 2 paquets :

• Contrôles de Formulaire
• Contrôles ActiveX

Il doit s'appeler SpinButton1 (double-clique dessus pour ajouter le code) et non Compteur 1

re & hello tout le Monde,

J'ai une proposition, voir pièce jointe, bon le code est super long par contre mais il fait des pli/repli successifs, j'espère que ça peut t'aider si tu n'arrive pas à faire fonctionner la macro d'Eriiic.

faut que j'aille bosser un peu mes macros pour mon boulot officiel, Bonne soirée tout le Monde.

Dim Sh As Shape 'Définit la variable comme étant un objet graphique en générale pour être définit dans la macro de pli/dépli en ligne synthèse
Dim Adresse_shape As Variant 'récupère l'adresse des boutons
Dim ok_depli As Boolean 'variable pour servir d'interrupteurs

Sub PLIER_DEPLIER_GROUPEMENT()
'Macro pour déplier et replier les plans de groupement de lignes
'________________________________________________________________________
'1. Déclaration des variables
Dim TEXTE As String 'Définit la variable comme étant du texte pour mettre à jour l'icone
'________________________________________________________________________
'2. Définition des variables
If ActiveSheet.Range("g1").Value = 0 Then 'définit le shape en cours seulement s'il ne s'agit pas d'un ordre de dépli/repli venant du bouton de groupement
Set Sh = ThisWorkbook.ActiveSheet.Shapes(Application.Caller) 'Définition de l'objet graphique
Set Adresse_shape = ActiveSheet.Shapes(Application.Caller).TopLeftCell 'Définition de l'adresse l'objet graphique
Else
If Cells(Adresse_shape.Row, Adresse_shape.Column + 1).Value = 0 And Not ok_depli = True Then 'si opération de dépli/repli du bouton d'ensemble et qu'il n'a pas déjà fait un dépli fait 1 dépli, sinon sort de la macro et arrête le dépli/repli successif
Exit Sub
End If
End If

TEXTE = Sh.TextFrame.Characters.Text 'Définition de la variable au contenu du texte en cours
'________________________________________________________________________
  '3. Action Partie 1 : mettre à jour l'icone en fonction de son état pour indiquer action pli ou repli
    If TEXTE = "+" Then
       Sh.TextFrame.Characters.Text = "-" 'Flèche bas en police webding
       Cells(Adresse_shape.Row, Adresse_shape.Column + 1).Value = 1 'interrupteur dans la colonne a coté du bouton prend 1 pour dépli du groupe
    Else
       Sh.TextFrame.Characters.Text = "+" 'Flèche haut en police webding
      Cells(Adresse_shape.Row, Adresse_shape.Column + 1).Value = 0 'interrupteur dans la colonne a coté du bouton prend 0 pour repli du groupe
             If ActiveSheet.Range("g1").Value = 1 Then 'si vient du bouton d'ensemble, l'interrupteur ok dépli prend vrai, et dans la prochaine boucle de for next, réalisera 1 dépli puis arrêt des macros
       ok_depli = True
       End If
    End If
   '3.E. Gestionnaire de gestion d'erreur
  On Error Resume Next
   '3. Action Partie 2 : Action pli ou repli sur cell en cours pour action sur groupement de ligne uniquement
    Rows(Sh.TopLeftCell.Row).ShowDetail = Not Rows(Sh.TopLeftCell.Row).ShowDetail
'________________________________________________________________________
'E. Gestionnaire de gestion d'erreur
 If Err.Number <> 0 Then
    MsgBox "Le bouton n'est pas placé au niveau du groupement de ligne [+], veuillez l'y déplacer", vbInformation, "Echec du Pli/Repli automatique"
  End If
End Sub

Sub PLIER_DEPLIER_ENSEMBLE_GROUPEMENTS()
Dim num_bouton As Double
Dim bouton As String
Dim marcheur_bouton As Double

On Error Resume Next

ActiveSheet.Range("g1").Value = 1 'la case en g1 sert d'interrupteur et prend 1 pour indiquer l'état du traitement

marcheur_bouton = 0
For i = 1 To 5 'boucle for next de 1 à 5, pour aller de 1 à 5 boutons étant donné qu'il y'a 5 boutons

If ok_depli = True Then '1 repli réalisé, passer au dépli du bouton suivant
num_bouton = 1 + marcheur_bouton
bouton = "rectangle " & num_bouton  'correspond au numéro du bouton rectangle, on commence à rectangle 1, donc numéro = 1
Set Sh = ThisWorkbook.ActiveSheet.Shapes(bouton) 'Définition de l'objet graphique
Set Adresse_shape = ActiveSheet.Shapes(bouton).TopLeftCell 'Définition de l'adresse l'objet graphique
PLIER_DEPLIER_GROUPEMENT 'action macro PLIER_DEPLIER_GROUPEMENT
Exit For 'une fois tout replier et déplier 1 groupe arrête la boucle for next
End If

'numéro bouton part de 1
num_bouton = 1 + marcheur_bouton
bouton = "rectangle " & num_bouton

Set Sh = ThisWorkbook.ActiveSheet.Shapes(bouton) 'Définition de l'objet graphique
Set Adresse_shape = ActiveSheet.Shapes(bouton).TopLeftCell 'Définition de l'adresse l'objet graphique

PLIER_DEPLIER_GROUPEMENT 'action macro PLIER_DEPLIER_GROUPEMENT

marcheur_bouton = marcheur_bouton + 1 'ok on va au prochain bouton le numéro prend +1

Next i
ok_depli = False
ActiveSheet.Range("g1").Value = 0
End Sub

@eriiic

Merci beaucoup.

Après avoir tout tenté, j'ai refermé mon fichier où la toupie ne voulait pas marcher.

Je le rouvre pour tester un nouveau truc : miracle ! Ça fonctionne !

Un dernier truc si ça ne te dérange pas : actuellement, quand je clique sur la flèche du bas de la toupie, la macro "déplie" les groupes du bas vers le haut, et inversement, quand je clique sur la flèche du haut, la macro "déplie" les groupes du haut vers le bas.

Comment faire pour inverser ce fonctionnement (flèche du bas → déplie vers le bas / flèche du haut → déplie vers le haut) ?

@waard

Merci pour ta contribution. Elle ne correspond pas tout à fait à ce que je cherchais (un bouton unique qui zappe de groupe de ligne en groupe de ligne), mais comme la macro d'eriiic est arrivée en 1er et qu'elle me convient, on peut en rester là. Mais merci bcp d'avoir cherché à m'aider.

Ca correspond à la toupie en horizontal (tracé plus large que haut) que j'avais mis.

Si verticale :

    i = pl.Count
    For Each c In pl
        groupe(i) = c.Row + 1
        i = i - 1
    Next c

eric

Cool !

Merci beaucoup !