Div Tab-Register einfärben je nach Zellinhalt

Hallo Excel-Freunde
jetzt suche ich seit geraumer Zeit nach einer Möglichkeit,
die Tabellen-Register automatisch einzufärben (Ampel-Schaltung)
- je nachdem, was in dem jeweiligen Tabellenblatt in einer bestimmten Zelle steht -
Hintergrund:
In einem Tabellenblatt "ToDo-Liste" werden verschiedenen Aufgaben erfasst,
und jeweils in einer Spalte die Aufgaben mittels einer Ampel-Schaltung
Grün - Prima / Gelb - Beobachten / Rot - Kritisch
in einer Spalte jeweils beurteilt.
Da die Anzahl der Aufgaben sehr umfangreich sind, habe ich für jede
einzelne Aufgabe jeweils mittels Formel ein separates Blatt als "Übersichtsblatt"
aller wichtigen Informationen erstellt.
In diesen Blättern steht IMMER in der Zelle C3 (auf Basis der Inhalte der Todo-Liste)
ein Text - Prima / Beobachten / Kritisch
Diese Zelle wird mittels bedingter Formatierung jeweils in Grün/Gelb/Rot oder Neutral (wenn kein Status vorhanden ist) formatiert !
Da es sehr viele einzelne Tabs sind (größer 70 !) soll nun das jeweilige Registerblatt
jeweils genau so farblich eingefärbt werden, wie es in der in der Zelle C3 formatiert
ist.
Also wenn in Zelle C3 steht:
"Prima" - wird die Zelle C3 in Grün formatiert
"Beobachten" - in Gelb
"Kritisch" - in Rot
ohne Inhalt - Normalformatierung
Die Veränderung der Zellinhalte dieser größer 70 Register sind also abhängig
von der Erfassungen in der "Quell"-Tabelle "Todo"
Jetzt soll bei jeder Änderung in der Tabelle "Todo" - es wird ja jetzt
sofort per Formel in der jeweiligen Tabelle die Zelle C3 geändert -
automatisch das jeweilige Tab-Register entsprechend des Textes in Zelle
C3 angepasst werden.
Ich hoffe, daß ich mein Thema einigermaßen verständlich formulieren konnte ;)
Ich kann die Datei leider nicht hochladen - größer 3 MB
Kurz-Zusammenfassung:
Steht in der Zelle C3 eines jeweiligen Registers der Text
"Prima" - Grün
"Beobachten" - Gelb
"Kritisch" - Rot
ohne Inhalt - Normalformatierung
soll das jeweilige Register entsprechend farblich markiert werden !
egal ob es 10 oder 100 Tabellen in einer Datei sind !
Freu mich auf einen Tip von Euch ;)
Besten Gruß
Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Blatt_faerben() 'Tastenkombination Strl+i Dim Wks As Worksheet Application.ScreenUpdating = False For Each Wks In ActiveWorkbook.Worksheets If IsNumeric(Wks.Name) = True And Wks.Range("C3").Value = "prima" Then Wks.Tab.ColorIndex = 10 ElseIf IsNumeric(Wks.Name) = True And Wks.Range("C3").Value = "beobachten" Then Wks.Tab.ColorIndex = 6 ElseIf IsNumeric(Wks.Name) = True And Wks.Range("C3").Value = "kritisch" Then Wks.Tab.ColorIndex = 3 ElseIf IsNumeric(Wks.Name) = True And Wks.Range("C3").Value = "" Then Wks.Tab.ColorIndex = xlColorIndexNone End If Next Wks Application.ScreenUpdating = True End Sub

Sub Blatt_faerben() 'Tastenkombination Strl+i Dim Wks As Worksheet Dim Farbe As Long Application.ScreenUpdating = False For Each Wks In ActiveWorkbook.Worksheets If IsNumeric(Wks.Name) Then Select Case Wks.Range("C3").Value Case "prima": Farbe = 10 Case "beobachten": Farbe = 6 Case "kritisch": Farbe = 3 Case Else: Farbe = xlNone End Select Wks.Tab.ColorIndex = Farbe End If Next Wks Application.ScreenUpdating = True End Sub

Hallo Robert,
nach doch einiger Zeit kann ich jetzt meine Thread weiter verfolgen
sorry, für die verspätete Rückmeldung.
Ich habe die letzte Datei von Dir 82516.xls jetzt geöffnet
und erhalte, wenn die den Zellinhalt von Zelle B5 von 1 auf 2 änder
folgenden Fehlerhinweis in XL2003 !
Laufzeitfehler '9' : Index außerhalb des gültigen Bereichs
Beim Debuggen bleibt er stehen bei
...
With ActiveWorkbook.Worksheets(ActiveCell.Offset(, -1).Text).Tab
...
Also: ICH gebe nicht auf ;)
Und freue mich seeehr, daß Du Dich der Thematik gemühst
und an einer Lösung interessiert bist !
Also : vorab vielen Dank für Deine Unterstützung
Natürlich gilt dieser Dank auch an ALLE ANDEREN in diesem Forum !
Besten Gruß
Werner
ps: habe den Thread als OFFEN gekennzeichnet !

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B1:B5")) Is Nothing And Target.Count = 1 Then 'Range anpassen _ oder auslesen With ActiveWorkbook.Worksheets(Target.Offset(, -1).Text).Tab Select Case Target.Value Case 1 .Color = vbGreen Case 2 .Color = vbYellow Case 3 .Color = vbRed Case Else .Color = xlNone End Select End With End If End Sub

Beliebteste Forumthreads (12 Monate)

Div Tab-Register einfärben je nach Zellinhalt

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

270 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Div Tab-Register einfärben je nach Zellinhalt

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

270 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread