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

je continue sur ma lancée
avec cette version, on choisit le jour dans une InputBox
Code:
Sub Test()
Dim crit_JOUR$
Jours = Array("LUNDI", "MARDI", "MERCREDI", "JEUDI", "VENDREDI")
crit_JOUR = Jours(InputBox("Choisir un jour de la semaine" & vbCr & " (de 1 à 5) ", "Choix jour", 1) - 1)
FILTRAGE crit_JOUR, "AB"
End Sub
Private Sub FILTRAGE(ByVal Jour As String, ByVal Agent As String)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("BV4").Formula = "=AND(A4=" & Chr(34) & Jour & Chr(34) & ",C4=" & Chr(34) & Agent & Chr(34) & ",D4<>""remplaçant"")"
Range("A3:D497").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("BV3:BV4"), Unique:=False
End Sub
 

Staple1600

XLDnaute Barbatruc
Re,

@halecs93
une dernière piste (avant ma lessive) ;)
Ici on a cinq boutons (des shapes -> Formes automatiques)
auxquels on affecte la même macro : macro_BOUTON
(Chaque forme porte le nom d'un jour (en majuscule)
Code:
Sub macro_BOUTON()
Dim Jour$
Jour = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
FILTRAGE Jour, "AB"
End Sub
Private Sub FILTRAGE(ByVal Jour As String, ByVal Agent As String)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("BV4").Formula = "=AND(A4=" & Chr(34) & Jour & Chr(34) & ",C4=" & Chr(34) & Agent & Chr(34) & ",D4<>""remplaçant"")"
Range("A3:D497").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("BV3:BV4"), Unique:=False
End Sub
Ci-dessous test avec deux boutons seulement
BoutonsCapture.PNG
NB: C'est une version allégée de ton fichier
(pour éviter que mon Excel plante)
 

halecs93

XLDnaute Impliqué
Re,

@halecs93
une dernière piste (avant ma lessive) ;)
Ici on a cinq boutons (des shapes -> Formes automatiques)
auxquels on affecte la même macro : macro_BOUTON
(Chaque forme porte le nom d'un jour (en majuscule)
Code:
Sub macro_BOUTON()
Dim Jour$
Jour = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
FILTRAGE Jour, "AB"
End Sub
Private Sub FILTRAGE(ByVal Jour As String, ByVal Agent As String)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("BV4").Formula = "=AND(A4=" & Chr(34) & Jour & Chr(34) & ",C4=" & Chr(34) & Agent & Chr(34) & ",D4<>""remplaçant"")"
Range("A3:D497").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("BV3:BV4"), Unique:=False
End Sub
Ci-dessous test avec deux boutons seulement
Regarde la pièce jointe 1179502
NB: C'est une version allégée de ton fichier
(pour éviter que mon Excel plante)
Ok, bien vu... mais du coup, j'ai changé d'approche...à forece de triturer excel. Je garde les filtres activés de la façon qui se présente dans le nouveau fichier joint.
 

Pièces jointes

  • halecs93- PLANNING- exceldownloads.xlsm
    601.3 KB · Affichages: 4

Staple1600

XLDnaute Barbatruc
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 macro
    ws.Range("BE1").Value = Jour
End Sub
 

halecs93

XLDnaute Impliqué
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 macro
    ws.Range("BE1").Value = Jour
End Sub
du coup, ça remplace les 6 macros ?
 

halecs93

XLDnaute Impliqué
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 macro
    ws.Range("BE1").Value = Jour
End Sub
Super ça. Merci
 

job75

XLDnaute Barbatruc
Bonsoir à tous,

Voyez le fichier joint avec une CheckBox et ces 2 macros dans le code de la feuille "MODELE" :
VB:
Private Sub CheckBox1_Change()
    Dim c As Range
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Me.Unprotect
    With Columns(4)
        .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()
    CheckBox1_Change
End Sub
Les 6 macros de filtrage journalier ne sont pas modifiées.

A+
 

Pièces jointes

  • halecs93- PLANNING- exceldownloads.xlsm
    611 KB · Affichages: 7

halecs93

XLDnaute Impliqué
Bonsoir à tous,

Voyez le fichier joint avec une CheckBox et ces 2 macros dans le code de la feuille "MODELE" :
VB:
Private Sub CheckBox1_Change()
    Dim c As Range
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Me.Unprotect
    With Columns(4)
        .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()
    CheckBox1_Change
End Sub
Les 6 macros de filtrage journalier ne sont pas modifiées.

A+
Très intéressant ça. Grand merci
 

Discussions similaires

Statistiques des forums

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