XL 2016 filtrer des lignes en vba

halecs93

XLDnaute Impliqué
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
1695546469466.png
 

Pièces jointes

  • halecs93- PLANNING- exceldownloads.xlsm
    599.9 KB · Affichages: 12
Solution
Re

En partant de ton dernier fichier
1) J'ai renommer les images avec le nom des jours
2) Affecter à ces images la même macro (sur le même principe que précédemment)
Code:
Sub macro_Bouton()
Jour = UCase(ActiveSheet.Shapes(Application.Caller).Name)
Filtrer Jour
End Sub
Private Sub Filtrer(ByVal Jour As String)
Dim ws As Worksheet
    Set ws = ActiveSheet
    ' Déproteger la feuille
    If ws.ProtectContents Then
        ws.Unprotect
    End If
    ' Protéger la feuille en autorisant la sélection des cellules verrouillées
    ws.Protect UserInterfaceOnly:=True, AllowFiltering:=True
    ' Appliquer le filtre
    ws.Range("A6:A500").AutoFilter Field:=1, Criteria1:=Jour, VisibleDropDown:=0
    ' Mettre à jour la cellule BE1 avec le nom de la...

Staple1600

XLDnaute Barbatruc
Re

@laurent950
Je viens de l'écrire dans le message#46 ;)
Fais le test avec des images sur un fichier vierge
Code:
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

XLDnaute Barbatruc
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 :

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
Code:
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)
Code:
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

VB:
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
 

Pièces jointes

  • Option - Filtres Textuelles- PLANNING- exceldownloads.xlsm
    587.8 KB · Affichages: 0

job75

XLDnaute Barbatruc
Bonjour halecs93, le forum,

Cette solution est meilleure que celle de mon post #44 :
VB:
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+
 

Pièces jointes

  • halecs93- PLANNING- exceldownloads.xlsm
    613.8 KB · Affichages: 2

halecs93

XLDnaute Impliqué
Bonjour halecs93, le forum,

Cette solution est meilleure que celle de mon post #44 :
VB:
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.
 

job75

XLDnaute Barbatruc
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 :
VB:
Private Sub Workbook_Open()
Sheets("MODELE").Activate
DéfiltrerTout 'lance la macro
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
313 297
Messages
2 096 927
Membres
106 789
dernier inscrit
FrancoisVLD