XL 2016 masquer lignes selon date

[eastwick]

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.

 

[sylvanu]

Bonjour Eastwick,
En PJ un essai avec :

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

 

[eastwick]

Toujours un service de qualité...
Merci beaucoup !

 

[Jacky67]

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

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

 

[eastwick]

Bonjour Eastwick,
En PJ un essai avec :

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

 

[eastwick]

Bonjour à tous
Hello sylvanu
Un truc plus simple sur double clic

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]

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

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

 

[eastwick]

RE..
Par bouton alors

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]

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.

 

[eastwick]

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

 

[sylvanu]

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 :

 

[eastwick]

Effectivement, je me fais mal comprendre mais on voit nettement sur votre animation que la ligne 23 datée du 09/11/2022 porte le n°4...

 

[Jacky67]

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

re..
Le principe de mon exemple est basé sur un filtre.
Pour laisser les filtres en place, changer cette ligne
.UsedRange.AutoFilter
par
.UsedRange.AutoFilter Field:=7

 

[eastwick]

Merci Jacky67