VBA - Masquer des lignes selon la date

Bonjour Exceleurs et Exceleuses. Petit problème VBA pour agrémenter votre pause du midi.

Mon niveau VBA étant d'environ 3/20, j'ai relu tous le cours VBA du site mais... en vain...

Je veux masquer des lignes de mon tableau, selon une date. Chacune de mes lignes correspond à une date. Je veux masquer toutes les dates précédents ma date définie mais pas que. Et c'est la où ça se complique. Je veux aussi masquer les lignes des semaines des dates postérieurs à la date définir + 2 semaines.

Bon, un exemple sera plus parlant : Nous sommes le mercredi 8 septembre (je sais, on est le 21, mais c'est pas grave). Je dois masquer tout ce qui précède le 8 septembre. Ca ça va (quoique... même ça j'y arrive pas). Mais aussi toutes les dates après le lundi .27 septembre. En gros je garde la semaine en cours + les 2 semaines d'après. C'est peut-être plus parlant comme ça.

Je vous laisse un tableau, mais y a rien dessus quasiment. Et un grand merci d'avance, comme d'hab !

J'oubliais ! La macro doit s'enclencher à l'ouverture du fichier ! Merci !

Merci pour ta réponse BibuNesco, mais... je ne vois rien, c'est tout blanc

Bonjour,

Ci-joint une proposition (en attendant le retour de BibuNesco !) :

Merci !!

C'est pas si mal. A la 1ère ouverture ça fonctionne mais

1/Je dois changer la date, fermer le classeur et le rouvrir pour que ça modifie à nouveau => J'aimerais que ça masque les lignes, dès le changement de date en L3

2/A la 2e ouverture du fichier, il n'y a que les dates antérieur qui sont masqués, pas les postérieurs.

Voici une nouvelle proposition qui devrait faire l'affaire.

1/Je dois changer la date, fermer le classeur et le rouvrir pour que ça modifie à nouveau => J'aimerais que ça masque les lignes, dès le changement de date en L3

En plus de la macro placée dans le "Workbook_Open" (à l'ouverture du classeur), j'ai rajouté à l'identique une macro dans le "Worksheet_Change" (à la modification de la cellule L3)

2/A la 2e ouverture du fichier, il n'y a que les dates antérieur qui sont masqués, pas les postérieurs.

Oui rectifié. L'ordre des 2 premières instructions du code était inversé.

Salut MrMarcadet,
Salut AntoineDL,

Code malheureusement à rallonge pour éviter toute erreur d'encodage en [L3]...
En fonction de ton fichier, il faudra adapter dans le code ci-dessous le nom de la feuille 'MAIN' !!

With Worksheets("MAIN")

Public Sub Masquage()
'
Dim iRow%
'
On Error Resume Next
With Worksheets("MAIN")
    .Rows.Hidden = False
    If IsDate(.[L3]) Then
        If Weekday(CDate(.[L3]), vbMonday) < 6 Then
            iRow = .Columns(2).Find(what:=CDate(.[L3]), lookat:=xlWhole, LookIn:=xlFormulas, searchdirection:=xlNext).Row
            If iRow > 0 Then
                If iRow > 9 Then .Rows("9:" & iRow - 1).Hidden = True
                If iRow - (Weekday(CDate(.[L3]), vbMonday) - 1) + 15 < .Range("B" & Rows.Count).End(xlUp).Row Then _
                    .Rows(iRow - (Weekday(CDate(.[L3]), vbMonday) - 1) + 15 & ":" & .Range("B" & Rows.Count).End(xlUp).Row).Hidden = True
            End If
        End If
    End If
End With
On Error GoTo 0
'
End Sub

A+

Bonjour,
Une autre proposition.
Les données sont sous forme de tableau structuré.
Cdlt.

Option Explicit

Private Sub Workbook_Open()
Dim lo As ListObject, dt0 As String, dt2 As String
    Set lo = Range("Table1").ListObject
    dt0 = Format(VBA.Date, "m/d/yyyy")
    dt2 = Format(WorksheetFunction.WorkDay(dt0, 15), "m/d/yyyy")
    With lo
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter Field:=2, _
                          Criteria1:=">=" & dt0, _
                          Operator:=xlAnd, _
                          Criteria2:="<" & dt2
    End With
End Sub

Ohlala !! Déjà merci à vous tous pour vos réponses !!

Ta solution AntoineDL fonctionne mais j'ai peur de ne pas réussir à la retranscrir exactement à mon fichier. Les 2 autres sont nickel, j'ai plus qu'à choisir. Par contre, ne sachant pas trop trop lire votre code, je ne vois pas où vous gérez le 2 semaines après la date. Au cas où je doive mettre 3 semaines ou 1 semaine.

Merci en tout cas !

Bonjour,
Voir commentaires pour dt0 et dt2.
Cdlt.

Private Sub Workbook_Open()
Dim lo As ListObject, dt0 As String, dt2 As String
    Set lo = Range("Table1").ListObject
    'aujourd'hui
    dt0 = Format(VBA.Date, "m/d/yyyy")
    'aujourd'hui + 15 jours ouvrés
    dt2 = Format(WorksheetFunction.WorkDay(dt0, 15), "m/d/yyyy")
    With lo
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter Field:=2, _
                          Criteria1:=">=" & dt0, _
                          Operator:=xlAnd, _
                          Criteria2:="<" & dt2
    End With
End Sub

Parfait, merci beaucoup !

Re,

Salut MrMarcadet,
Salut Jean-Eric,

pour afficher les 2 semaines de plus, la macro calcule d'abord le lundi de la semaine contenant la date choisie.

iRow - (Weekday(CDate(.[L3]), vbMonday) - 1)

Donc, tu comptes le nombre de lignes séparant ce lundi au lundi après la semaine à conserver.
-> + 10 = 1 semaine de plus ;
-> + 15 = 2 semaines ;
-> + 20 = 3 semaines
...

Pour vérifier qu'il reste quelque chose à effacer, la macro vérifie si ce dernier lundi à effacer existe dans ta BDD.

If iRow - (Weekday(CDate(.[L3]), vbMonday) - 1) + 15 < .Range("B" & Rows.Count).End(xlUp).Row Then

A+

Capiche !

Et, petite question, comment faire pour qu'il garde la semaine actuelle entière ? On garderait en fait que la semaine en cours et les 2 suivantes.

Merci !

Bonjour,
Essaie ainsi :

dt0 = Format(VBA.Date - WeekDay(VBA.Date,3), "m/d/yyyy")

M'en doutais presque pas qu'elle allait arriver, celle-là !

Dans ce cas, tu vérifies si le vendredi précédent cette semaine en cours existe et tu englobes le lundi...

If iRow - Weekday(CDate(.[L3]), vbMonday) > 9 Then .Rows("9:" & iRow - Weekday(CDate(.[L3]), vbMonday)).Hidden = True

A+

Ah ah ! Je suis terriblement prévisible :p

En tout cas merci à vous 2. j'ai privilégié la solution de Curulis57, mais merci aussi Jean-Eric bien sûr !