Private Sub Worksheet_Calculate()
If AlterWert <> Tabelle2.Cells(1, 1).Value Then
Call Worksheet_Change(Range(Cells(1, 1), Cells(1, 1)))
AlterWert = Tabelle2.Cells(1, 1).Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim K As Shape, roo As String, v As Variant
Dim ro, co As Integer
ro = Target.Row
co = Target.Column
v = Cells(ro, co).Value
roo = LTrim(Str$(ro))
If Len(roo) = 1 Then roo = "0" + roo
If Target.Column = 1 And Row < 200 Then
Set K = Tabelle1.Shapes(roo)
K.Fill.Visible = msoTrue
K.Line.Visible = msoFalse
If v <= 10 And v >= 0 Then
K.Fill.ForeColor.SchemeColor = 10
ElseIf v <= 20 And v > 10 Then
K.Fill.ForeColor.SchemeColor = 12
Else
K.Fill.ForeColor.SchemeColor = 1
End If
End If
End Sub
|