XL 2016 masquer lignes selon date

eastwick

XLDnaute Impliqué
Bonjour à toutes et tous,

Je souhaiterais un bouton unique, style interrupteur, pour masquer les dates contenues dans la colonne G inférieures à aujourd'hui ou à l'inverse tout afficher à nouveau.
Je vous remercie.
 

Pièces jointes

  • Classeur1.xlsm
    10.1 KB · Affichages: 7

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Eastwick,
En PJ un essai avec :
VB:
Sub Gestion()
    a = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
    If ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text = "MASQUER" Then
        Masquer
        ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text = "DEMASQUER"
    Else
        Démasquer
        ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text = "MASQUER"
    End If
End Sub
Sub Masquer()
    Application.ScreenUpdating = False
    DL = Range("G65500").End(xlUp).Row                      ' Dernière ligne
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ' Insére colonne en premier (A)
    f = "=SI(H2<AUJOURDHUI();CAR(1);0)"                     ' Formule utilisée
    Set r = Range("A2:A" & DL)                              ' Plage où coller la formule qui sera triée
    r.FormulaLocal = f                                      ' Coller formule
    r.EntireRow.Sort r.Cells, xlDescending                  ' Tri pour regrouper et accélérer
    r.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True  ' Masquage
    Columns("A:A").Delete Shift:=xlToLeft                   ' Suppression de la colonne ajoutée
End Sub
Sub Démasquer()
    ' Démasque tout
    Rows("2:65000").EntireRow.Hidden = False
End Sub
 

Pièces jointes

  • Classeur1 (7).xlsm
    18.6 KB · Affichages: 5

Jacky67

XLDnaute Barbatruc
Bonjour à toutes et tous,

Je souhaiterais un bouton unique, style interrupteur, pour masquer les dates contenues dans la colonne G inférieures à aujourd'hui ou à l'inverse tout afficher à nouveau.
Je vous remercie.
Bonjour à tous
Hello sylvanu
Un truc plus simple sur double clic
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address <> "$L$1" Then Exit Sub
    Cancel = True
    [l1] = IIf([l1] = "Masquer", "Afficher", "Masquer")
    If [l1] = "Masquer" Then
        Range("$G$1:$G$2").AutoFilter Field:=1
    Else
        Range("$G$1:$G$2").AutoFilter Field:=1, Criteria1:=">=" & CLng(Date)
    End If
End Sub
 

Pièces jointes

  • Doubleclic.xlsm
    21.4 KB · Affichages: 6
Dernière édition:

eastwick

XLDnaute Impliqué
Bonjour Eastwick,
En PJ un essai avec :
VB:
Sub Gestion()
    a = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
    If ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text = "MASQUER" Then
        Masquer
        ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text = "DEMASQUER"
    Else
        Démasquer
        ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text = "MASQUER"
    End If
End Sub
Sub Masquer()
    Application.ScreenUpdating = False
    DL = Range("G65500").End(xlUp).Row                      ' Dernière ligne
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ' Insére colonne en premier (A)
    f = "=SI(H2<AUJOURDHUI();CAR(1);0)"                     ' Formule utilisée
    Set r = Range("A2:A" & DL)                              ' Plage où coller la formule qui sera triée
    r.FormulaLocal = f                                      ' Coller formule
    r.EntireRow.Sort r.Cells, xlDescending                  ' Tri pour regrouper et accélérer
    r.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True  ' Masquage
    Columns("A:A").Delete Shift:=xlToLeft                   ' Suppression de la colonne ajoutée
End Sub
Sub Démasquer()
    ' Démasque tout
    Rows("2:65000").EntireRow.Hidden = False
End Sub
à sylvanu :
effectivement ça fonctionne mais les dates sont rangées par chronologie, ce que je ne souhaite pas !
chaque date doit garder sa ligne.
Merci beaucoup
 
Dernière édition:

eastwick

XLDnaute Impliqué
Bonjour à tous
Hello sylvanu
Un truc plus simple sur double clic
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address <> "$L$1" Then Exit Sub
    Cancel = True
    [l1] = IIf([l1] = "Masquer", "Afficher", "Masquer")
    If [l1] = "Masquer" Then
        Range("$G$1:$G$2").AutoFilter Field:=1
    Else
        Range("$G$1:$G$2").AutoFilter Field:=1, Criteria1:=">=" & CLng(Date)
    End If
End Sub
Merci Jacky67, les dates conservent leur ligne mais il me faut un bouton car ce job n'est pas pour moi.
Merci
 

Jacky67

XLDnaute Barbatruc
Merci Jacky67, les dates conservent leur ligne mais il me faut un bouton car ce job n'est pas pour moi.
Merci
RE..
Par bouton alors
VB:
Private Sub CommandButton1_Click()
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        CommandButton1.Caption = IIf(CommandButton1.Caption = "Masquer", "Afficher", "Masquer")
        If CommandButton1.Caption = "Masquer" Then
            .UsedRange.AutoFilter
        Else
            .UsedRange.AutoFilter Field:=7, Criteria1:=">=" & CLng(Date)
        End If
    End With
End Sub
 

Pièces jointes

  • ParBouton.xlsm
    24.5 KB · Affichages: 5
Dernière édition:

eastwick

XLDnaute Impliqué
RE..
Par bouton alors
VB:
Private Sub CommandButton1_Click()
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        CommandButton1.Caption = IIf(CommandButton1.Caption = "Masquer", "Afficher", "Masquer")
        If CommandButton1.Caption = "Masquer" Then
            .UsedRange.AutoFilter
        Else
            .UsedRange.AutoFilter Field:=7, Criteria1:=">=" & CLng(Date)
        End If
    End With
End Sub
Le principe est ok mais y a t-il possibilité de ne pas filtrer/défiltrer ? Car il y aura un filtre en permanence pour les autres colonnes.
Merci
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
La macro de Jacky, que je salue ici, est bien plus esthétique et plus courte.


Cependant, juste pour les futurs lecteurs, votre assertion est fausse :
mais les dates sont rangées par chronologie, ce que je ne souhaite pas ! chaque date doit garder sa ligne.
Vérifiez dans cette PJ, l'ordre des lignes ne changent pas.
 

Pièces jointes

  • Classeur1 (7) (1).xlsm
    19.1 KB · Affichages: 2

eastwick

XLDnaute Impliqué
Re,
La macro de Jacky, que je salue ici, est bien plus esthétique et plus courte.


Cependant, juste pour les futurs lecteurs, votre assertion est fausse :

Vérifiez dans cette PJ, l'ordre des lignes ne changent pas.
J'ai changé une date en ligne 4 et elle a bougé sauf erreur de ma part. Seules les dates avant aujourd'hui restent à leur place, pas celles postérieures à aujourd'hui...
J'espère m'être fait comprendre.
Merci
 

Pièces jointes

  • Classeur1 (7) (1).xlsm
    18.8 KB · Affichages: 1
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Alors nous ne devons pas nous comprendre.
En ligne 4 vous avez mis 06/01/2022. J'ai beau masquer démasquer cette date est toujours en ligne 4 :
20220916_212313.gif
 

Discussions similaires

Réponses
6
Affichages
257