Encore les codes couleur

[pro-blême]

Bonjour le forum, salut aux XLDiens

Je fais partie des "effacés" du mois de Mars, mais cela ne m'a pas empêché de vous suivre tout ce temps.
Après moulte recherches, je reviens sur la question des filtres couleur...

J'ai bien vu que la Princesse Celeda était aux anges https://www.excel-downloads.com/threads/couleur-dans-les-filtres.37460/
mais je n'ai pas su mettre en oeuvre la formule magique de Thierry
Pour faire court, je cherche un filtre qui colorise la colonne active comme celle-ci
(onglet filtre couleur), mais pour des variables aussi bien numériques que alpha-numériques.
Le miracle aura-t-il lieu cette fois encore ?
Certainement grâce à votre puit de Savoir...

 

[skoobi]

Re : Encore les codes couleur

Bonsoir,
si j'ai bien compris, remplace dans le code ce qui est en rouge:

Private Sub Worksheet_Calculate()
Dim i As Byte
'Hervé

With ActiveSheet.AutoFilter
    For i = 1 To .Filters.Count
        [COLOR="Red"][B]Columns(i)[/B][/COLOR].Interior.ColorIndex = xlNone
        If .Filters(i).On = True Then
            [B][COLOR="Red"]Columns(i)[/COLOR][/B].Interior.ColorIndex = i + 34
        End If
    Next i
End With

End Sub

 

[CB60]

Re : Encore les codes couleur

Bonjour
Je pense que c'est mieux comme cela.

Private Sub Worksheet_Calculate()
Dim i As Byte
'Hervé
On Error Resume Next
With ActiveSheet.AutoFilter
For i = 1 To .Filters.Count
Cells(1, i).Select
Range(Selection, Selection.End(xlDown)).Interior.ColorIndex = xlNone
If .Filters(i).On = True Then
Cells(1, i).Select
Range(Selection, Selection.End(xlDown)).Interior.ColorIndex = i + 34
End If
Next i
End With
End Sub

 

[Bisson]

Re : Encore les codes couleur

Bonjour,

 Application.Volatile
  ChampActif = Sheets(Application.Caller.Parent.Name).AutoFilter.Filters.Item(c.Column -   Sheets(Application.Caller.Parent.Name).Range("_FilterDataBase").Column + 1).On
End Function

Function ChampActif(c)


Pour appliquer une MFC sur les titres:
-Sélectionner A1:C1-Format/mise en forme conditionnelle/La formule est
=ChampActif(A1)

Bisson

 

[CB60]

Re : Encore les codes couleur

re
Bisson
La fonction que tu présente est bien

Correction du post


Edit J'ai ajouté la fonction de Bisson car elle fonctionne aussi sur la colonne filtrée

 

[pro-blême]

Re : Encore les codes couleur

Bonjour à tous, et merci de bien vouloir vous pencher sur ma question.
Je n'ai pas encore testé la soluce de Bisson car je travaillais sur celle de CB60.

En fait, j'ai peut-être mal formulé ma question. La macro qui m'interressait est celle qui se trouve sur l'onglet 4 "couleur filtre" dans le fichier code couleur.

Je vous joins un exemple de fichier sur lesquel je travaille.

PS. Je suis une brêle, je n'ai pas réussi à faire marcher ta soluce CB60

 

[CB60]

Re : Encore les codes couleur

re
Voici ton fichier, j'ai ajouté une colonne avec la fonction aléa (colonne A) et maintenant ça fonctionne, j'avais essaye " Application volatile" mais ça ne donné rien.

 

[pro-blême]

Re : Encore les codes couleur

Hello Bruno

Super, ça fonctionne à merveille. Quelle efficacité ce forum !!!
Une dernière question:
Quand j'actionne un filtre, l'affichage se décale sur les colonnes les plus à droite.
Est-du à ma version de Excel (2002) ?
Quoi qu'il en soit, merci encore et bravo !!!
J'ai oublié de remercier les autres membres qui ont bien voulu m'aider, leurs solutions étaient justes, simplement décalées par rapport à mes besoins.

Merci à tous

 

[CB60]

Re : Encore les codes couleur

re
je ne sais pas pourquoi cela se décale et je ne peux pas tester car je n'ai pas excel 2002.

 

[pro-blême]

Re : Encore les codes couleur

re
je ne sais pas pourquoi cela se décale et je ne peux pas tester car je n'ai pas excel 2002.

Never mind, je testerai ça au bureau, j'ai la version 2006...

@++

 

[Cousinhub]

Re : Encore les codes couleur

Bonjour pro-bleme, bruno

le décalage provient des .select

tu peux modifier comme ceci :

Private Sub Worksheet_Calculate()
Dim i As Byte
'Hervé
On Error Resume Next
With ActiveSheet.AutoFilter
    For i = 1 To .Filters.Count
        ' seulement pour l'entête
        'Cells(1, i).Interior.ColorIndex = xlNone
'        Cells(1, i).Select
        Range(Cells(1, i), Cells(1, i).End(xlDown)).Interior.ColorIndex = xlNone
        If .Filters(i).On = True Then
            ' seulement pour l'entête
            'Cells(1, i).Interior.ColorIndex = i + 34
'            Cells(1, i).Select
            Range(Cells(1, i), Cells(1, i).End(xlDown)).Interior.ColorIndex = i + 34

        End If
    Next i
End With

End Sub

mettre des quotes devant les lignes Cells(1, i).Select et remplacer Selection par Cells(1, i)

Bon week-end

 

[pro-blême]

Re : Encore les codes couleur

Bonjour pro-bleme, bruno

le décalage provient des .select

tu peux modifier comme ceci :

Impec bhbh. Il y a même des peaufineurs ici !
Trop top level... Merci à tous

 

[CB60]

Re : Encore les codes couleur

Bien vu Bhbh