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
Bonjour à tousBonjour à 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.
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 :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
Merci Jacky67, les dates conservent leur ligne mais il me faut un bouton car ce job n'est pas pour moi.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
RE..Merci Jacky67, les dates conservent leur ligne mais il me faut un bouton car ce job n'est pas pour moi.
Merci
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.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
Vérifiez dans cette PJ, l'ordre des lignes ne changent pas.mais les dates sont rangées par chronologie, ce que je ne souhaite pas ! chaque date doit garder sa ligne.
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...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.
re..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