Hintergrundfarbe in Abhängigkeit v. Kriterien
27.09.2005 12:39:13
Michael
es stellt sich in folgendem VBA-Code die Frage in welcher Codezeile die Hintergrundfarbe festgelegt. Ausschlaggebend hierfür sind Werte zweier Spalten einen Tabelle. In der eínen wird ein Datum in Bezug zum gegewärtigen gesetzt, in der anderen nur zwischen O, F und [leer] unterschieden. Es gibt demnach drei Zustände, die farblich gekennzeichnet werden: weiß (neutral), orange (relevant), rot (akut).
Wo wird in welcher Art und Weise diese Einfärbung vorgenommen?
Sub InsertFormulas(iRow As Integer)
Dim bScreenUpdate As Boolean
If iRow <= Range("Filter_Zeile").Row Or _
iRow >= Range("Letzte_Zeile").Row _
Then
Exit Sub
End If
bScreenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
If (Cells(iRow, Range("Datum_Spalte").Column).Value = "") Then
Cells(iRow, Range("Datum_Spalte").Column).Value = Date + Time
End If
' If (Cells(iRow, Range("Nr_Spalte").Column).Value = "") Then
' Cells(iRow, Range("Nr_Spalte").Column).Value = Range("Max_Nr").Value
' End If
Call EntryNumbers
If Cells(iRow, Range("AI_Nr_Spalte").Column).Value = "" Then
Cells(iRow, Range("AI_Nr_Spalte").Column).Value = Range("Max_AI_Nr").Value
End If
' If (Cells(iRow, Range("Verantwortlich_Spalte").Column).Value = "" And _
' Cells(iRow, Range("AI_Nr_Spalte").Column).Value <> "") Then
' Cells(iRow, Range("AI_Nr_Spalte").Column).Value = ""
' End If
If IsEmpty(Cells(iRow, Range("AktDatum_Spalte").Column)) _
Then
Cells(Range("Template_Zeile").Row, Range("AktDatum_Spalte").Column).Copy
Cells(iRow, Range("AktDatum_Spalte").Column).PasteSpecial
End If
If Cells(iRow, Range("Offen_Spalte").Column).Formula = "" _
Then
Cells(Range("Template_Zeile").Row, Range("Offen_Spalte").Column).Copy
Cells(iRow, Range("Offen_Spalte").Column).PasteSpecial
Rows(Range("Template_Zeile").Row).Copy
Rows(iRow).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Rows(iRow).AutoFit
End If
Application.CutCopyMode = False
Application.ScreenUpdating = bScreenUpdate
End Sub
Sub New_Entry()
Rows(Range("Neuer_Eintrag_Zeile").Row).Copy
Rows(Range("Letzte_Zeile").Row).Insert Shift:=xlDown
Rows(Range("Template_Zeile").Row).Copy
Rows(Range("Neuer_Eintrag_Zeile").Row).PasteSpecial
Rows(Range("Neuer_Eintrag_Zeile").Row).AutoFit
Application.CutCopyMode = False
Call Application.Goto("Letzte_Zeile", True)
Call ActiveWindow.LargeScroll(0, 1, 0, 0)
Call ActiveWindow.SmallScroll(1, 0, 0, 0)
Range("Neuer_Eintrag").Select
End Sub
Vielen Dank für jegliche Hilfe!!
Michael