Supportnet / Forum / Tabellenkalkulation

Zelle ändert durch bedingte Formatierung ihre Hintergrundfarbe. In VBA-Makro sollen in Abhängigkeit der Zellenfarbe verschiedene Aktionen ablaufen. Bei Abfrage über Range("A1").interior.colorindex erscheint bei bedingt formatierten Zellen stets ein Negativwert -4154. Wie kann man die Farbe bedingt formatierter Zellen über VBA auswerten ?

hi all :)

warum muehe geben wenn einer es nicht mal fuer noetig haelt zu gruessen.

gruss nighty

kopieren und einfuegen geht gerade noch

Function GetCellColor(cell As Range) As Integer
Dim i
Dim myVal
Dim myColor As Integer
Dim done As Boolean
On Error Resume Next
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
Case xlBetween
If (myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2)) _
Or (myVal <= Evaluate(.Formula1) And myVal >= Evaluate(.Formula2)) Then
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
End If
End With
If done Then Exit For
Next
Application.ReferenceStyle = xlA1
GetCellColor = myColor
End Function

Hi Nighty,

besten Dank für den Funktionscode.

mfG

kraft

hi all :)

noch in dem zusammenhang eine funktion um durch bedingte formatierung eingefaerbte zellen zu addieren

gruss nighty

die funktion arbeitet mit der obigen variante

rem syntax BedingungAdd(BEREICH;FARBINDEX)

Function BedingungAdd(Zellen As Range, farbe As Integer) As Double
Dim Zelle As Range
Dim farben As Integer
Application.Volatile
For Each Zelle In Zellen
farben = GetCellColor(Zelle)
If farben = farbe Then
BedingungAdd = BedingungAdd + Zelle.Value
End If
Next
End Function

• Quelcode in ein macro einbinden
• Zellen in def. Bereich in Abhängigkeit von Zahlen färben
• VBA: Range mit vielen Zellen
• Zellen vergleichen
• Zellen färben in einer xls-Tabelle