XL 2016 filtrer des lignes en vba

halecs93 · 24 Septembre 2023

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 · 24 Septembre 2023

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 · 24 Septembre 2023

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 · 24 Septembre 2023

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

NB: C'est une version allégée de ton fichier
(pour éviter que mon Excel plante)

halecs93 · 24 Septembre 2023

Staple1600 à dit:
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.

Staple1600 · 24 Septembre 2023

Re

Pourquoi continuer à avoir 6 fois la même macro de filtre ?
Alors que je t'ai montré qu'on pouvait n'en utiliser qu'une.

halecs93 · 24 Septembre 2023

Staple1600 à dit:
Re

Pourquoi continuer à avoir 6 fois la même macro de filtre ?
Alors que je t'ai montré qu'on pouvait n'en utiliser qu'une.

Parce que j'essaie de comprendre, mais n'y arrive pas toujours

Staple1600 · 24 Septembre 2023

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 · 24 Septembre 2023

Staple1600 à dit:

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 ?

Staple1600 · 24 Septembre 2023

Re

Oui, il faut simplement renommer les 6 images avec le nom des jours
Exemple ci-dessous pour LUNDI

Ensuite affecter la macro nommée macro_Bouton à ces images

Staple1600 · 24 Septembre 2023

Bonjour @job75

Inutile de toucher aux autres macros (sauf si on veut simplifier leur code mais bof...).

Les temps ont bien changés alors...
Ou René n'est plus dans ta bibliothèque

halecs93 · 24 Septembre 2023

Staple1600 à dit:

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

laurent950 · 24 Septembre 2023

Bonsoir @Staple1600

Comment tu fais pour récupérer la zone de texte ici
Dim Jour$
Jour = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
Lundi est une image ?

laurent950 · 24 Septembre 2023

Re @halecs93
Tu peux reposter ton dernier fichier s'il te plait
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)

halecs93 · 24 Septembre 2023

laurent950 à dit:
Re @halecs93
Tu peux reposter ton dernier fichier s'il te plait
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)

Naturellement, le voici

job75 · 24 Septembre 2023

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+

halecs93 · 24 Septembre 2023

job75 à dit:
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

XL 2016 filtrer des lignes en vba

halecs93

XLDnaute Impliqué

Pièces jointes

Staple1600

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

halecs93

XLDnaute Impliqué

Pièces jointes

Staple1600

XLDnaute Barbatruc

halecs93

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

halecs93

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

halecs93

XLDnaute Impliqué

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

halecs93

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

halecs93

XLDnaute Impliqué

Discussions similaires