Tabkleur met voorwaardelijke opmaak

[PajaNegor]

Hallo beste mensen,

Dit is de eerste keer dat ik op het forum een vraag stel.
Ik heb al een voorbeeld gezien op het forum wat bij mij wel werkt.

http://www.helpmij.nl/forum/showpost.php?p=1760650&postcount=10

maar ik zoek een uitgebreidere versie.

Mijn vraag is echter:
Weet iemand deze code te wijzigen zodat ik niet twee kleuren nl rood en standaard, maar ca 10 kleuren kas gebruiken?
zoiets als een case?

alvast bedankt,
PajaNegor

Private Sub Worksheet_Calculate()
Dim SheetNaam As String
    SheetNaam = Range("B1").Value
    
    If Range("K20").Value = "70" Then
       ' Zet de kleur op ROOD
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = 3
    Else
        ' Zet de kleur weer nogmaal
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = -4142
    End If
End Sub

 

[Wigi]

Bijvoorbeeld:

Private Sub Worksheet_Calculate()
    Select Case [K20]
        Case 70: Sheets([B1]).Tab.ColorIndex = 3
        Case 80: Sheets([B1]).Tab.ColorIndex = 6
        Else: Sheets([B1]).Tab.ColorIndex = -4142
    End Select
End Sub

Voeg cases toe zoals getoond.

Wigi

 

[PajaNegor]

Wigi
Bedankt het heeft mij een heel end op weg geholpen
Het klopte niet helemaal.
maar met de aanpassing zoals onder gaat het nu goed.
Geweldig

Ik heb nu echter een PROBLEEM!

Als ik een ander excel bestand open gaat de module calculeren en geeft de volgende foutmelding.

Fout 9 tijdens uitvoering:
Het subscribt valt buiten het bereik

Enig idee wat ik hieraan moet doen?

Groet PajaNegor

Private Sub Worksheet_Calculate()
Dim SheetNaam As String
    SheetNaam = Range("N1").Value
    Select Case [a5]
        Case Is = "1"
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = 3
        Case Is = "2"
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = 6
        Case Is = "3"
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = 5
        Case Is = "4"
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = 4
        Case Else
        ActiveWorkbook.Sheets(SheetNaam).Tab.ColorIndex = -4142
    End Select
End Sub

 

[Wigi]

In dat geval moet je beter refereren aan je bereiken. O.a. ThisWorkbook ipv. ActiveWorkbook.

 

[snb]

Gebruik een andere gebeurtenis en minder code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  on error resume next
  if Target.Address="$A$5" then me.Tab.ColorIndex =choose(target.value,3,6,5,4)
End Sub

en dit is natuurlijk nog handiger:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  on error resume next
  if Target.Address="$A$5" then me.Tab.ColorIndex =target.value
End Sub

 

[Warme bakkertje]

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  Sheets([N1].Value).Tab.ColorIndex = xlNone
  If Target.Address = "$A$5" Then Sheets([N1].Value).Tab.ColorIndex = Choose(Target.Value, 3, 6, 5, 4)
End Sub

Hiermee wordt de kleur v/d tab eerst verwijderd zodat bij een foutieve waarde-invoer de oude kleur niet blijft staan.