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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen