Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
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 😉
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...
@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
Enrichi (BBcode):
Sub macro_Bouton()
Jour = UCase(ActiveSheet.Shapes(Application.Caller).Name)
Filtrer Jour
End Sub
'
' 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)
Sub FiltrerJoursSemaine()
Application.ScreenUpdating =TrueDim Tsemaine AsVariant
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 =FalseDim Jour As Shape
Set Jour = ws.Shapes.Item(Application.Caller)Dim LeJour AsStringFor i = LBound(Tsemaine,1)To UBound(Tsemaine,1)If Jour.Name = Tsemaine(i)(1)Then LeJour = Tsemaine(i)(2):ExitForNext 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 AsLong
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 =FalseEndSub
Cette solution est meilleure que celle de mon post #44 :
VB:
Dim P As Range 'mémorise la variablePrivateSub CheckBox1_Change()
Application.ScreenUpdating =False
Application.EnableEvents =FalseMe.Unprotect
With IIf(P IsNothing,Me.UsedRange.Columns(4), P).Replace "remplaçant","#N/A".SpecialCells(xlCellTypeConstants,16).EntireRow.Hidden =Not CheckBox1
.Replace "#N/A","remplaçant"EndWithMe.Protect
Application.EnableEvents =TrueEndSubPrivateSub Worksheet_Calculate()Set P =Me.UsedRange.Columns(4).SpecialCells(xlCellTypeVisible)
CheckBox1_Change
EndSub
Cette solution est meilleure que celle de mon post #44 :
VB:
Dim P As Range 'mémorise la variablePrivateSub CheckBox1_Change()
Application.ScreenUpdating =False
Application.EnableEvents =FalseMe.Unprotect
With IIf(P IsNothing,Me.UsedRange.Columns(4), P).Replace "remplaçant","#N/A".SpecialCells(xlCellTypeConstants,16).EntireRow.Hidden =Not CheckBox1
.Replace "#N/A","remplaçant"EndWithMe.Protect
Application.EnableEvents =TrueEndSubPrivateSub Worksheet_Calculate()Set P =Me.UsedRange.Columns(4).SpecialCells(xlCellTypeVisible)
CheckBox1_Change
EndSub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD