Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
If Target.Value = 1 Then Target.Interior.ColorIndex = 10
If Target.Value = 2 Then Target.Interior.ColorIndex = 4
If Target.Value = 3 Then Target.Interior.ColorIndex = 36
If Target.Value = 4 Then Target.Interior.ColorIndex = 6
If Target.Value = 5 Then Target.Interior.ColorIndex = 45
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies *
'* 19.07.03, 30.10.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In Range(Target.Address)
With Range(RaZelle.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "1"
.Interior.ColorIndex = 4
Case "2"
.Interior.ColorIndex = 35
Case "3"
.Interior.ColorIndex = 6
Case "4"
.Interior.ColorIndex = 38
Case "5"
.Interior.ColorIndex = 33
Case Else
.Interior.ColorIndex = xlNone
End Select
End If
End With
Next RaZelle
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies *
'* 19.07.03, 30.10.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A1")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In Range(Target.Address)
With Range(RaZelle.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "1"
.Interior.ColorIndex = 4
Case "2"
.Interior.ColorIndex = 35
Case "3"
.Interior.ColorIndex = 6
Case "4"
.Interior.ColorIndex = 38
Case "5"
.Interior.ColorIndex = 33
Case Else
.Interior.ColorIndex = xlNone
End Select
End If
End With
Next RaZelle
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies *
'* 19.07.03, 30.10.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("D24")
' noch mehr Bereiche
' Set RaBereich = Union(Range("D24:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In Range(Target.Address)
With Range(RaZelle.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "sehr gut"
.Interior.ColorIndex = 4
Case "gut"
.Interior.ColorIndex = 35
Case "befriedigend"
.Interior.ColorIndex = 6
Case "ausreichend"
.Interior.ColorIndex = 38
Case "mangelhaft"
.Interior.ColorIndex = 33
Case Else
.Interior.ColorIndex = xlNone
End Select
End If
End With
Next RaZelle
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies *
'* 19.07.03, 30.10.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("C24:C46")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In Range(Target.Address)
With Range(RaZelle.Address).Offset(0, 1)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "1"
.Interior.ColorIndex = 4
Case "2"
.Interior.ColorIndex = 35
Case "3"
.Interior.ColorIndex = 6
Case "4"
.Interior.ColorIndex = 38
Case "5"
.Interior.ColorIndex = 33
Case Else
.Interior.ColorIndex = xlNone
End Select
End If
End With
Next RaZelle
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub