den unten stehenden Code zum Auslesen von Farbindizes bei bedingter Formatierung habe ich von "Hajos Excelseiten".
Alles verstehe ich dabei nicht. Wo müsste ich ansetzen, wenn ich diesen Nummerncode in eine dafür vorgesehene Zeile einer bestimmten Spalte kopiert haben möchte?
Function GetCellColor(cell As Range) As Integer
Dim i
Dim myVal
Dim myColor As Integer
Dim done As Boolean
On Error Resume Next
Names("testname").Delete
On Error GoTo 0
Application.ReferenceStyle = xlR1C1
myVal = cell.Value
myColor = cell.Interior.ColorIndex
done = False
For i = 1 To cell.FormatConditions.Count
With cell.FormatConditions.Item(i)
If .Type = 1 Then
Select Case .Operator
' Original von Bernd
' Case xlBetween
' If myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2) Then
' myColor = .Interior.ColorIndex
' done = True
' End If
' Veränderung von Simon Hirsbrunner
Case xlBetween
If (myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2)) _
Or (myVal <= Evaluate(.Formula1) And myVal >= Evaluate(.Formula2)) Then
'Das fehlt meiner Meinung nach noch (OR), sonst muss Formula1 immer der
'grössere Wert der Schranke sein (Was wenn Formula1 = 5 und Formula2
'= 2 -> der xlBetween gibt nichts zurück. (Rest wieder Standart)
myColor = .Interior.ColorIndex
done = True
End If
Case xlEqual
If myVal = Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreater
If myVal > Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreaterEqual
If myVal >= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLess
If myVal < Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLessEqual
If myVal <= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotBetween
If myVal < Evaluate(.Formula1) Or myVal > Evaluate(.Formula2) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotEqual
If myVal <> Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
End Select
ElseIf .Type = 2 Then
Names.Add Name:="testname", RefersToR1C1Local:=.Formula1
If Evaluate("testname") Then
myColor = .Interior.ColorIndex
done = True
End If
Names("testname").Delete
Else
MsgBox "Unbekannter Typ: " & .Type, , "PANIC: In
Function GetCellColor"
Exit Function
End If
End With
If done Then Exit For
Next
Application.ReferenceStyle = xlA1
GetCellColor = myColor
End Function
Danke für Hilfe,
Paul