excel autofilter kleuren

[hoogendijk]

Beste mensen,

Ik heb een vraag over het kleuren van de "auto filter pijl" in het dropdown menu.
Graag wil ik de actieve pijl in een kleur hebben als deze is geselecteerd.
Hopelijk heeft iemand een mooie oplossing.
Ik heb een testbestandje bijgevoegd.
Hierin heb ik een kleur over de pijl geplaatst als voorbeeld.

Alvast bedankt.

met vriendelijke groet,

Ewoud

 

[alphamax]

Het filterje zelf kan je geen andere kleur geven
Maar
De cel waar het filterje in staat wel

Private Sub Worksheet_Calculate()
    'autofilter interior
    With ActiveSheet.AutoFilter
        Set oHeader = .Range.Rows(1)
        For Each oFilter In .Filters
            iCol = iCol + 1
            If oFilter.On Then
                oHeader.Cells(iCol).Interior.ColorIndex = 22
            Else
                oHeader.Cells(iCol).Interior.ColorIndex = xlColorIndexNone
            End If
        Next
    End With
    Set oFilter = Nothing
    Set oHeader = Nothing
End Sub

Worksheet_Calculate werkt omdat er een formule in het blad staat.
Staat er geen formule dan werkt het niet.
Of je moet een dummy-formule invoeren.

 

[hoogendijk]

excel autofiliter kleuren

Beste Alphamax,

Hartelijk dank voor deze oplossing, werkt prima.
Het helpt een groter sheet (112 kolommen en 800 rijen) overzichtelijker te houden.

vriendelijke groet,

Ewoud

 

[alphamax]

Hier nog een stukje code om het misschien nog wat overzichtelijker te maken.
De volgorde waarin de filters erop gezet worden komt overeen met de volgorde van de regenboog
Hierdoor kan je systematisch je data analyseren zonder het overzicht te verliezen

Option Explicit

Private Sub Worksheet_Calculate()
    'de volgorde waarin de filters zijn toegepast, komt overeen met volgorde van de kleuren van de regenboog
    'the order in which the filters are applied, resembles the order of the colors of the rainbow, am_2022
    Dim aColor As Variant
    Dim bOn As Boolean
    Dim iColor As Long
    Dim jFilter As Long
    Dim lColor As Long
    Dim lColorFound As Long
    Dim lColors As Long
    Dim lFilters As Long
    
    On Error Resume Next
    
    aColor = Array(RGB(255, 0, 0), RGB(255, 165, 0), RGB(255, 255, 0), RGB(0, 128, 0), RGB(0, 0, 255), RGB(75, 0, 130))    'hard
    aColor = Array(RGB(255, 201, 222), RGB(253, 217, 124), RGB(251, 253, 170), RGB(193, 240, 178), RGB(178, 228, 240), RGB(214, 178, 240))    'pastel
   
    lColors = UBound(aColor)
    With ActiveSheet.AutoFilter
        lFilters = .Filters.Count
        For jFilter = 1 To lFilters
            bOn = .Filters(jFilter).On
            With .Range.Cells(1, jFilter).Interior
                If bOn Then
                    If .Color = vbWhite Then
                        .Color = aColor(lColors)
                    End If
                Else
                    .Color = vbWhite
                End If
            End With
        Next
        For iColor = 0 To lColors
            lColor = aColor(iColor)
            For jFilter = 1 To lFilters
                With .Range.Cells(jFilter).Interior
                    If .Color = lColor Then
                        .Color = aColor(lColorFound)
                        lColorFound = lColorFound + 1
                    End If
                End With
            Next
        Next
    End With
End Sub

 

[hoogendijk]

Beste Alphamax,

Hartelijk dank, TOP!!!!.
Wat een uitgebreide code met een mooi resultaat.
Ik ga het zeker toepassen.

Nogmaals mijn dank!

vriendelijke groet,

Ewoud