XL 2016 masquer lignes selon date

eastwick à dit:

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.

Cliquez pour agrandir...

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

sylvanu à dit:

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

Cliquez pour agrandir...

Jacky67 à dit:

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

Cliquez pour agrandir...

eastwick à dit:

Merci Jacky67, les dates conservent leur ligne mais il me faut un bouton car ce job n'est pas pour moi.
Merci

Cliquez pour agrandir...

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

Jacky67 à dit:

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

Cliquez pour agrandir...

mais les dates sont rangées par chronologie, ce que je ne souhaite pas ! chaque date doit garder sa ligne.

Cliquez pour agrandir...

sylvanu à dit:

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.

Cliquez pour agrandir...

eastwick à dit:

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

Cliquez pour agrandir...