Kleur tabblad wijzigen met VBA

[Symon1989]

Goedendag,

Ik zit al een tijdje te stoeien met VBA. Ik wil graag dat de kleur van een tabblad word gewijzigd bij de onderstaande voorwaarden.

Wanneer de niet-geblokkeerde cellen leeg zijn, dan tabblad kleur is 'geen kleur'
Wanneer in de niet-geblokkeerde cellen iets staat, dan tabblad kleur is 'Groen'

Als dit niet mogelijk is dan het volgende;

Wanneer in de cellen C2 t/m H6 of E12 t/m T116 of R2 t/m Y6 t/m AI t/m AP6 leeg zijn, dan tabblad kleur is 'geen kleur'
Wanneer in de cellen C2 t/m H6 of E12 t/m T116 of R2 t/m Y6 t/m AI t/m AP6 iets staat, dan tabblad kleur is 'Groen'

Kunnen jullie mij een VBA code geven die dit tot stand kan brengen?

Alvast bedankt.

 

[Niels28]

Je geeft niet aan wanneer je de marco wilt laten starten, dus maar een voorbeeld voor en normale module.

Sub Macro1()
With ActiveWorkbook.Sheets("Blad1")
    For Each cl In Union(.Range("C2:H6"), .Range("E12:T116"), .Range("R2:Y6"))
        If cl.Value <> "" Then
            With ActiveWorkbook.Sheets("Blad1").Tab
                .Color = 5287936
                .TintAndShade = 0
            End With
            Exit For
            Else
            With ActiveWorkbook.Sheets("Blad1").Tab
                .Color = xlAutomatic
                .TintAndShade = 0
            End With
        End If
    Next
End With

End Sub

Niels

 

[Symon1989]

Niels,

Bedankt voor je reactie.
Ik zou graag willen dat deze macro start wanneer iemand iets invult in het tabblad.
Ik wil dit graag willen toepassen op alle tabbladen behalve de eerste (blad2 en blad55 t/m blad106

Alvast bedankt

 

[Niels28]

voorbeeldje voor achter thisworkbook.
Het zal wel een stuk makkelijker kunnen...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
i = "|" & LCase(Sh.Name) & "|"
If InStr("|blad2|blad55|blad56|blad57|blad58|", i) > 0 Then Exit Sub
If Not Intersect(Target, Union(Range("C2:H6"), Range("E12:T116"), Range("R2:Y6"))) Is Nothing Then

With Sh
    For Each cl In Union(.Range("C2:H6"), .Range("E12:T116"), .Range("R2:Y6"))
        If cl.Value <> "" Then
            With Sh.Tab
                .Color = 5287936
                .TintAndShade = 0
            End With
            Exit For
            Else
            With Sh.Tab
                .Color = xlAutomatic
                .TintAndShade = 0
            End With
        End If
    Next
End With
End If


End Sub

Niels

 

[Symon1989]

Niels,

Bedankt.
Werk perfect.

Groet

 

[snb]

@symon

Het is niet de bedoeling dat je dezelfde vraag in verschillende (sub)fora tegelijkertijd plaatst zonder daarvan melding te maken (zie 'crossposting').

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If InStr("|blad2|blad55|blad56|blad57|blad58|","|" & LCase(Sh.Name) & "|") > 0 Then Exit Sub
    If Intersect(Target, sh.Range("C2:H6,E12:T116,R2:Y6")) Is Nothing Then exit sub

On error resume next

    Sh.tab.color=xlautomatic
    y=sh.Range("C2:H6,E12:T116,R2:Y6").specialcells(4).address

    if err.number=0 then Sh.Tab.Color = 5287936
End If