XL 2016 filtrer des lignes en vba

[halecs93]

Bonjour à tout le monde. Et encore un grand merci à toutes les personnes qui m'ont permis de bien avancer.

Je poursuis donc mon classeur "planning" et je bute sur une chose. Il s'agit de déclencher les filtres afin de ne faire apparaître, par exemple, que les lundis. J'ai bricolé un petit quelque chose qui semble fonctionner. En cliquant sur un des jours de la semaine, ça filtre bien (même si ce n'est pas super joli de voir apparaitre le bouton de filtrage).

Mais si je veux obtenir, toujours par exemple, uniquement les lundis et sans les lignes "remplaçant".... je bloque.

Pas certain que ça puisse se faire, mais je poste quand même 😉

Encore une fois, un grand merci

 

[Staple1600]

Re,

@laurent950
J'ai d'abord testé sur mon fichier test avec des formes
Ensuite quand j'ai vu qu'@halecs93 utilisait des images, j'ai changé de syntaxe
cf cette macro

Sub macro_Bouton()
Jour = UCase(ActiveSheet.Shapes(Application.Caller).Name)
Filtrer Jour
End Sub

 

[laurent950]

Re @Staple1600

mais comment tu fais avec les images ?

 

[Staple1600]

Re

@laurent950
Je viens de l'écrire dans le message#46 😉
Fais le test avec des images sur un fichier vierge

Sub Test()
MsgBox UCase(ActiveSheet.Shapes(Application.Caller).Name)
End Sub

Insère une forme automatique puis une image
et affecte cette macro aux deux.
Tu verras que la macro affiche bien le nom de forme et ou de l'image.

 

[laurent950]

Re @halecs93 @Staple1600

Je te poste ma synthèse de ce que j'ai pensé @Staple1600
j'ai utilisé l'option de la boite de dialogue intégré Filtres Textuelles

Merci @Staple1600 c'est astucieux Application.Caller

je te détail ci-dessous

Fitres Excel avec VBA :

Mémento sur la programmation en VBA pour EXCEL - Tome 1

Il s'agit d'une compilation d'exemples pratiques pour apprendre la programmation en Microsoft Office Excel avec VBA

laurent-ott.developpez.com

Recherchez dans l'aide « Énumération XlBuiltInDialog » pour obtenir une liste des boîtes de dialogue disponibles.
https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlbuiltindialog ---> « Énumération XlBuiltInDialog »

' Chaques images (lundi / mardi / mercredi / jeudi / vendredi / samedi) est associé a ce Module VBA "FiltrerJoursSemaine"

' En Premier avant de réutiliser les filtres
' Désactiver tous les filtres pour afficher toutes les données
ws.AutoFilterMode = False

A vous de régler ci-dessus.

' affiche la boite de dialogue : Filtres textuels
application.Dialogs(xlDialogFilter).Show 1 ----> ici 1 pour Field:=1
Application.Dialogs(xlDialogFilter).Show 4 ----> ici 4 pour Field:=4

' Récupére la derniniére action interface utilisateur : Application.Caller
Dim Jour As Shape
Set Jour = ws.Shapes.Item(Application.Caller)

' Image (renommée les images semaine)
Lundi = Image - J1
Mardi = Image - J2
Mercredi = Image - J3
Jeudi = Image - J4
Vendredi = Image - J5
Samedi = Image - J6
'
' Correspondance : Image avec Nom de la semaine

Dim Tsemaine As Variant
        Tsemaine = Array([{"Image - J1","lundi"}], [{"Image - J2","mardi"}], [{"Image - J3","mercredi"}], _
                         [{"Image - J4","jeudi"}], [{"Image - J5","vendredi"}], [{"Image - J6","samedi"}])

'
' Pour utilisé une boite de dialogue intégré ici (Filtres textuelles)
' Utiliser la boîte de dialogue "Filtres textuels" pour la colonne D
Application.Dialogs(xlDialogFilter).Show 4 (C'est pour le champs de la colonne D)
Plus précis
'
'
' Masque la flèche déroulante de chaque filtres (Au choix)

ws.Range("A6" & lastRow).AutoFilter Field:=2, VisibleDropDown:=False
        ws.Range("A6" & lastRow).AutoFilter Field:=3, VisibleDropDown:=False
        ws.Range("A6" & lastRow).AutoFilter Field:=4, VisibleDropDown:=False

Sub FiltrerJoursSemaine()
    Application.ScreenUpdating = True
    Dim Tsemaine As Variant
        Tsemaine = Array([{"Image - J1","lundi"}], [{"Image - J2","mardi"}], [{"Image - J3","mercredi"}], _
                         [{"Image - J4","jeudi"}], [{"Image - J5","vendredi"}], [{"Image - J6","samedi"}])
    Dim ws As Worksheet
        Set ws = Worksheets(ActiveSheet.Name)
    ' Désactiver tous les filtres pour afficher toutes les données
        ws.AutoFilterMode = False
    Dim Jour As Shape
        Set Jour = ws.Shapes.Item(Application.Caller)
    Dim LeJour As String
        For i = LBound(Tsemaine, 1) To UBound(Tsemaine, 1)
            If Jour.Name = Tsemaine(i)(1) Then LeJour = Tsemaine(i)(2): Exit For
        Next i
    ' Déprotéger la feuille active
        ws.Unprotect
    ' Désactiver tous les filtres pour afficher toutes les données
        ws.AutoFilterMode = False
    ' Activer le filtre à partir de la cellule A5:D5 pour "lundi" et "remplaçant"
    Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row + 10
    ' Filtre la colonne A pour "lundi"
        ws.Range("A6:D" & lastRow).AutoFilter Field:=1, Criteria1:="=" & LeJour, VisibleDropDown:=False
    ' Filtre la colonne D pour différent de "remplaçant"
    ' Utiliser la boîte de dialogue "Filtres textuels" pour la colonne D
        Application.Dialogs(xlDialogFilter).Show 4
    ' Masque la flèche déroulante
        ws.Range("A6:D" & lastRow).AutoFilter Field:=2, VisibleDropDown:=False
        ws.Range("A6:D" & lastRow).AutoFilter Field:=3, VisibleDropDown:=False
        ws.Range("A6:D" & lastRow).AutoFilter Field:=4, VisibleDropDown:=False
    ' Protéger la feuille active
    ws.Protect
    Application.ScreenUpdating = False
End Sub

 

[job75]

Bonjour halecs93, le forum,

Cette solution est meilleure que celle de mon post #44 :

Dim P As Range 'mémorise la variable

Private Sub CheckBox1_Change()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Me.Unprotect
    With IIf(P Is Nothing, Me.UsedRange.Columns(4), P)
        .Replace "remplaçant", "#N/A"
        .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = Not CheckBox1
        .Replace "#N/A", "remplaçant"
    End With
    Me.Protect
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate()
    Set P = Me.UsedRange.Columns(4).SpecialCells(xlCellTypeVisible)
    CheckBox1_Change
End Sub

A+

 

[halecs93]

Bonjour halecs93, le forum,

Cette solution est meilleure que celle de mon post #44 :

Dim P As Range 'mémorise la variable

Private Sub CheckBox1_Change()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Me.Unprotect
    With IIf(P Is Nothing, Me.UsedRange.Columns(4), P)
        .Replace "remplaçant", "#N/A"
        .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = Not CheckBox1
        .Replace "#N/A", "remplaçant"
    End With
    Me.Protect
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate()
    Set P = Me.UsedRange.Columns(4).SpecialCells(xlCellTypeVisible)
    CheckBox1_Change
End Sub

A+

Merci, je vais regarder cela.

 

[laurent950]

Bonjour @halecs93

Pour mon dernier code vous en penser quoi ?

 

[halecs93]

Bonjour @halecs93

Pour mon dernier code vous en penser quoi ?

Il m'a semblé intéressant. Cependant, je crois que ça me demandait de modifier en profondeur l'ergonomie de l'onglet.

 

[job75]

3 remarques sur le fichier de mon post #50.

1) En feuille "MODELE' il manquait des 2èmes MARDI et MERCREDI en colonne A, j'ai corrigé.

2) J'ai supprimé la MFC en colonne A de la feuille "MODELE".

3) Dans ThisWorkbook j'ai ajouté cette macro pour initialiser :

Private Sub Workbook_Open()
Sheets("MODELE").Activate
DéfiltrerTout 'lance la macro
End Sub