froschkoenig-lr
Goto Top

Excel - Karteireiter färben, wenn Zellfarbe rot in 2 Spalten gefunden wurde

Hallo zusammen,

auch in Excel habe ich noch eine offene Baustelle bei der ich irgendwie nicht voran komme.

In einer Exceltabelle möchte ich den Register-Tab (Namen) rot färben, wenn in Spalte C10-C1000 oder F10-F1000 ein Feld eine rote Hintergundfarbe aufweist.
Wird kein rotes Feld gefunden, soll der Register-Tab grün gefärbt werde.

Im Internet habe ich dies gefunden:
'Karteireiter einfärben  
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Application.CountIf(Sh.Range("C10:C100"), "fällig") > 0 Then  
    Sh.Tab.ColorIndex = 3
  Else
    Sh.Tab.ColorIndex = 4
  End If
End Sub

Dieser VB-Code reagiert wiederum nur auf Spalte C sowie auf das Wort "fällig", Spalte F fehlt mir.

Deshalb denke ich wäre es einfacher nur nach roter Hintergrundfarbe zu suchen und den Karteireiter zu färben. Das ganze wenn möglich automatisch, ohne Schaltfläche.
Nur wie setzt man das um?

Weis jemand Rat?

Vielen Dank. face-smile

Content-Key: 566117

Url: https://administrator.de/contentid/566117

Ausgedruckt am: 28.03.2024 um 17:03 Uhr

Mitglied: 143728
143728 19.04.2020 aktualisiert um 22:15:57 Uhr
Goto Top
Bitteschön, in "DieseArbeitsmappe" einfügen deine Zellen ändern und schon färbt sich der jeweilige Reiter Rot oder Grün automatisch:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim myrng as Range
    Set myrng = Sh.Range("C10:C1000,F10:F1000")  
    If Not Application.Intersect(myrng, Target) Is Nothing Then
        Dim Cell As Range, found As Boolean
        For Each Cell In myrng
            If DisplayedColor(Cell, True, False) = RGB(255, 0, 0) Then
                found = True
                Exit For
            End If
        Next
        Sh.Tab.ColorIndex = IIf(found, 3, 4)
    End If
End Sub


' Funktion von hier geliehen (ermittelt die Farbe einer Zelle egal ob direkt zugewiesen oder über Bedingte Formatierung angenommen)   
' http://www.excelfox.com/forum/showthread.php/338-Get-Displayed-Cell-Color-(whether-from-Conditional-Formatting-or-not)  

Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, Optional ReturnColorIndex As Long = True) As Long
  Dim X As Long, Test As Boolean, CurrentCell As String
  If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."  
  CurrentCell = ActiveCell.Address
  For X = 1 To Cell.FormatConditions.Count
    With Cell.FormatConditions(X)
      If .Type = xlCellValue Then
        Select Case .Operator
          Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
          Case xlNotBetween:   Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
          Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
          Case xlNotEqual:     Test = Evaluate(.Formula1) <> Cell.Value
          Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
          Case xlLess:         Test = Cell.Value < Evaluate(.Formula1)
          Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
          Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
        End Select
      ElseIf .Type = xlExpression Then
        Application.ScreenUpdating = False
        Cell.Select
        Test = Evaluate(.Formula1)
        Range(CurrentCell).Select
        Application.ScreenUpdating = True
      End If
      If Test Then
        If CellInterior Then
          DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
        Else
          DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
        End If
        Exit Function
      End If
    End With
  Next
  If CellInterior Then
    DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
  Else
    DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
  End If
End Function
Mitglied: Froschkoenig-LR
Froschkoenig-LR 19.04.2020 aktualisiert um 19:53:42 Uhr
Goto Top
Hallo cabrinha,

Vielen Dank für deine Unterstützung. ☺

Ich habe dein Code übernommen, aber erhalte nach dem speichern einen Laufzeitfehler 1004 (Anwendungs- oder objektdefinierter Fehler).
Nach dem debuggen wird die Zeile 2 gelb markiert.

Weisst du weshalb?

Dankeschön 😊
Mitglied: 143728
143728 19.04.2020 aktualisiert um 21:46:04 Uhr
Goto Top
Wahrscheinlich keine auf Deutsch eingestellte .. Region nimm mal statt dem Komma das Semikolon als Trenner zwischen den Ranges in Zeile 2. Hier klappt es einwandfrei im Test.
Mitglied: Froschkoenig-LR
Froschkoenig-LR 19.04.2020 aktualisiert um 22:03:15 Uhr
Goto Top
Ein Semikolon hatte ich bereits versucht, stets das selbe...
Falls du die Region des Notebook meinst, das steht auf Deutsch/Deutschland.
unbenannt
Mitglied: 143728
143728 19.04.2020 aktualisiert um 22:21:08 Uhr
Goto Top
Hier geht's mit dem Komma wie gesagt einwandfrei (Excel 2010-2019). Dein System und den Aufbau deiner Sheets kennt hier ja keiner, mach halt mal erst einen einzelnen Range draus.
Wechsle auch mal den Variablen-Namen, vielleicht ist der bei dir von was anderem schon belegt(mit anderem Typ deklariert) Plugin oder ähnlichem.
Mitglied: Froschkoenig-LR
Froschkoenig-LR 19.04.2020 um 22:39:35 Uhr
Goto Top
Habe nun die Exceldatei als .xlsm gespeichert, wenn ich nun alle roten Hintergrundfarben in den Zellen entferne, bekomme ich nun folgende Meldung:
Laufzeitfehler 13: Typen unverträglich
(Siehe Bild bzgl. debuggen)

Ist der Inhalt der Zellen relevant? Datum, Text, etc.?
unbenannt
Mitglied: Froschkoenig-LR
Froschkoenig-LR 20.04.2020 aktualisiert um 14:10:24 Uhr
Goto Top
Hallo zusammen,

ich wollte erwähnen, dass ich eine Lösung gefunden habe um den Tabellenreiter zu färben.

Es wird nur in Spalte C nach "fällig" gesucht und der Reiter wird rot eingefärbt. Ist kein "fällig" vorhanden, bekommt der Reiter die Farbe grün.
Auf die Spalte F werde ich verzichten.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Application.CountIf(Sh.Range("C10:C100"), "fällig") > 0 Then  
    Sh.Tab.ColorIndex = 3
  Else
    Sh.Tab.ColorIndex = 4
  End If
End Sub

@143728
Vielen Dank für deine Anteilnahme, doch der Code scheint mir für diese Anwendung und für mein Wissen doch recht komplex zu sein, daher wähle ich die einfachere Variante. face-wink