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:
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.
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 !