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 = 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
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
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