PDA

Vollständige Version anzeigen : VBA - Registerfarbe nach Datumsprüfung ändern


MTerhechte
30.08.2017, 16:49
HAllo Zusammen,

ich suche eine Lösung die Registerfarbe äbhängig von einem Datum zu ändern.
z.B.
Datum älter als 3 Wochen Registerfarbe = orange
Datum älter als 5 Wochen Registerfarbe = rot

Das Datum steht in jedem Blatt in B2.

Vielen Dank für Eure Hilfe...

VG Terry

Hajo_Zi
30.08.2017, 17:12
unter Diese Arbeitsmappe.

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If IsDate(Range("B2")) Then
Select Case Date - Range("B2")
Case Is >= 35
ActiveSheet.Tab.Color = 39423
Case Is >= 21
ActiveSheet.Tab.Color = 255
Case Else
ActiveSheet.Tab.ColorIndex = xlAutomatic
End Select
End If
End Sub


<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

aloys78
30.08.2017, 17:48
Hallo Terry,

mein Vorschlag:
Option Explicit


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
With Sh
If IsDate(.Range("B2")) Then
Select Case Date - .Range("B2")
Case Is > 35
.Tab.ColorIndex = 3
Case Is > 21
.Tab.Color = RGB(255, 153, 0)
Case Else
.Tab.ColorIndex = xlColorIndexNone
End Select
Else
.Tab.ColorIndex = xlColorIndexNone
End If
End With
End Sub
Wichtig: Code im VBE unter DieseArbeitsmappe einfügen.

Gruß
Aloys

MTerhechte
30.08.2017, 18:41
Hallo Hajo,
Hallo Aloys,

vielen Dank für die schnellen Antworten.
Leider klappt das nicht für meine Zwecke - vielleicht liegt es daran das ich das Datum per S-Verweis in das Blatt hole...

VG Terry

Luschi
30.08.2017, 18:50
Hallo Terry,

wenn die Zelle mit dem SVerweis() nicht als Datum formatiert ist, dann liefert dieser Vergleich
If IsDate(.Range("B2")) Then
den Wert 'False' und die Formatierung in der Select-Klausel wird nicht ausgelöst.

Gruß von Luschi
aus klein-Paris

aloys78
30.08.2017, 18:54
Hallo Terry,
vielleicht liegt es daran das ich das Datum per S-Verweis in das Blatt hole...
Wie ist denn B2 formatiert ? Im Code wird ja abgefragt, ob B2 ein gültiges Datum enthält ?

Gruß
Aloys

MTerhechte
30.08.2017, 19:08
Die ist als Datum formatiert

aloys78
30.08.2017, 19:34
Hallo Terry,
Die ist als Datum formatiert
Wenn

- B2 ein gültiges Datum enthält und
- der Code im VBE unter DieseArbeitsmappe steht

dann kann ich ohne Beispieldatei nichts weiter tun. Bei mir funktioniert es einwandfrei.

Gruß
Aloys

MTerhechte
31.08.2017, 17:44
So, habs jetzt doch hinbekommen! :-)

Danke nochmal!!!

Mein Fehler war, das ich in meiner Tabelle das Datum nicht mehr in B2 sondern in C2 stehen habe :grins:

Farbe ändert sich allerdings erst wenn ich den Reiter anklicke!

Geht das dann mit "SheetChange" und wie muss ich das eintragen???


VIELEN DANK!!!!

aloys78
01.09.2017, 06:38
Hallo Terry,
Farbe ändert sich allerdings erst wenn ich den Reiter anklicke!
Geht das dann mit "SheetChange" und wie muss ich das eintragen???
Sheet_Change geht hier nicht.
Ich benutze Sheet_Activate, weil ich davon ausging, dass das Datum in B2 im laufenden Geschäft geändert werden könnte. Der Nachteil: zu Beginn sind alle Tabs ohne Farbe.

Ersetze den vorhandenen Code durch den nachstehenden. Dann erfolgt die Markierung schon beim Öffnen der Datei und nach Änderung auch schon nach dem Aktivieren des betreffenden Blattes.
Der Code muß im VBE unter DieseArbeitsmappe abgelegt werden, da er ja für alle Blätter gelten soll.
Option Explicit

Private Sub Workbook_Open()
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
Call TabMarkieren(Sh)
Next Sh
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call TabMarkieren(Sh)
End Sub

Sub TabMarkieren(Sh As Object)
With Sh
If IsDate(.Range("B2")) Then
Select Case Date - .Range("B2")
Case Is > 35
.Tab.ColorIndex = 3
Case Is > 21
.Tab.Color = RGB(255, 153, 0)
Case Else
.Tab.ColorIndex = xlColorIndexNone
End Select
Else
.Tab.ColorIndex = xlColorIndexNone
End If
End With
End Sub

Gruß
Aloys

MTerhechte
09.09.2017, 10:27
Vielen Dank Aloys,

hab's jetzt so wie zuerst beschrieben hinbekommen :-)

Bin jetzt aber auf ein weiteres Problem gestoßen:


Die Daten "Name" (B2) und "Datum" (B3) aus "REKLAMATIONEN" sollen per Klick auf "Neue Rekla" in die Tabelle eingetragen werden.
Das wird auch erledigt, allerdings steht dann immer in A6 "'!A1" was vermutlich aus meinem Makro Hyperlinks einfügen stammt, das hat
dann aber zur Folge das die die restliche Prozedur nicht mehr ausgeführt werden kann.

Mit der Datei will ich folgendes umsetzten.

a) die Daten Name und Datum sollen in die Liste eingetragen werden
b) die Liste soll alphabetisch sortiert werden
c) wenn ein neuer Datensatz in die Liste eingetragen wird soll ein Register erstellt werden
- hier hab ich das Problem das ein Name nicht 2 mal auftauchen kann, was falsch ist
Dim shNeu As Worksheet
Dim strText As String
Dim z As Long
With Sheets("Reklamationen")
For z = 6 To .Cells(Rows.Count, 1).End(xlUp).Row
strText = .Cells(z, 1)
If strText <> "" Then
If Not BlattExistiert(strText) Then
Sheets("neu").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = strText
End If
End If
Next
End With

weiß aber nicht wie ich das umschreiben muß. Vielleicht wenn man den Namen und das Datum als gemeinsame Referenz nimmt???

d) die Register sollen alphabetisch sortiert werden
e) wenn in "Erledigt am:" ein Datum steht soll der Register ausgeblendet werden - funktioniert
f) wenn eine bestimmte Zeit zum "Erstreklamationsdatum" vorliegt soll sich die Registerfarbe ändern - funktioniert
g) Spalte B & C in "Reklamationen" sind zur Kontrolle, wenn ich in B5 ein "x" setzte werden auch die ausgeblendeten Register wieder angezeigt. - funktioniert

Bin jetzt schon öfter dran gewesen und habe immer nur Teilerfolge gehabt, immer wenn ich eins zum Laufen bekommen habe hat etwas anderes nicht mehr funktioniert. Ich bin kurz vorm ausrasten und verhaspele mich immer mehr...

Hoffe jemand hat ne Idee und kann mir helfen.

Vielen Dank im Voraus.

Mit freundlichsten Grüßen
Terry

E.GO
09.09.2017, 13:23
Hallo Terry,
mit dieser Datenbank machst du dir keine Freude.

1.Stell dir mal vor, du hast 1000 Register, wie behältst du da den Überblick?
2.Deine Datei wird riesig groß werden.
3.Eine Statistik oder ein Diagramm sind da in Zukunft nur schwer möglich.
4.Du hast keine fortlaufende Reklamationsnummer. u.u.u.

Mein Rat:
Benutze VBA und pack alles in ein Tabellenblatt.

LG E.GO

E.GO
10.09.2017, 09:55
Hallo Terry,

hab dir mal eine kleine Vorlage gebaut, wie so was aussehen könnte.
Anpassen, auch gerne mit Hilfe, mußt du sie noch.
Hoffe es bringt dich weiter.

LG E.GO

MTerhechte
11.09.2017, 06:38
Hallo E.GO,

das ist ja der Hammer!!! :eek: - Vielen, vielen Dank.

Allerdings kann ich keine neuen Daten eintragen.
Ich habe die Inhalte gelöscht und wollte neue anlegen, aber das klappt nicht?
Ich benötige wohl doch nochmal Hilfe...

Kann man da eigentlich ein Datenblatt (pro Reklamation) ausdrucken?

Wahrscheinlich mache ich irgendwas falsch...

LG

E.GO
11.09.2017, 09:55
Hallo Terry,
schön, dass es dir gefällt.

Einen Neuen Datensatz kannst du anlegen, indem du evtl. mit neue Rekla die Textboxen auf der linken Seite löschst, danach deine Daten eingibst und auf speichern klickst.
Die Tabelle pro Reklamation hab ich angelegt.
Nun frag ich mich, welche Daten sollen hier rein und wie sollen sie aufbereitet sein?

LG E.GO