Wie kann ich bei Excel einstellen, dass ein Feld, sobald ich es markiere bzw. darein klicke, eine andere Farbe darstellt und diese Feld beim verlassen wieder die Ursprungsfarbe annimmt?
Private Sub Workbook_Open()
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
StOldRange = ActiveCell.Address
StRegister = ActiveSheet.Name
InOldColorIndex = ActiveCell.Interior.ColorIndex
' Unprotect "Test"
ActiveCell.Interior.ColorIndex = 3
' Protect "Test"
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If BoAktion = True Then Exit Sub
If Target.Count > 1 Then Exit Sub
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
' Falls beim öffnen keine Tabelle aktiv ist StOldRange noch undefiniert
If StOldRange = "" Then
StOldRange = Target.Address
InOldColorIndex = Target.Interior.ColorIndex
' Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 3
Else
' Setze alten Range auf alte Farbe
If Range(StOldRange).Interior.ColorIndex = 3 Then
Range(StOldRange).Interior.ColorIndex = InOldColorIndex
End If
InOldColorIndex = Target.Interior.ColorIndex
' Merke mir aktuellen Adresse für nächsten Aufruf
StOldRange = Target.Address
' Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 3
End If
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If BoAktion = True Then Exit Sub
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
If StOldRange <> "" Then .Range(StOldRange).Interior.ColorIndex = InOldColorIndex
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
' falls Farbe beim Druck wieder zurückgestellt werden soll
' nach Druck ist die aktuelle Zelle nicht markiert
If BoAktion = True Then Exit Sub
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
If StOldRange <> "" Then .Range(StOldRange).Interior.ColorIndex = InOldColorIndex
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
BoAktion = False
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
StOldRange = ActiveCell.Address
InOldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
' .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 3
' .Protect "Test"
End With
StRegister = ActiveSheet.Name
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If BoAktion = True Then Exit Sub
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With Worksheets(StRegister)
' .Unprotect "Test"
If StOldRange <> "" Then .Range(StOldRange).Interior.ColorIndex = InOldColorIndex
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
BoAktion = Not BoAktion
If BoAktion = True Then
' nach Hinweis von Peter Haserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With Worksheets(StRegister)
' .Unprotect "Test"
If StOldRange <> "" Then .Range(StOldRange).Interior.ColorIndex = InOldColorIndex
' .Protect "Test"
End With
End If
Else
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
' Falls beim öffnen keine Tabelle aktiv ist StOldRange noch undefiniert
If StOldRange = "" Then
StOldRange = Target.Address
InOldColorIndex = Target.Interior.ColorIndex
' Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 3
Else
' Setze alten Range auf alte Farbe
If Range(StOldRange).Interior.ColorIndex = 3 Then
Range(StOldRange).Interior.ColorIndex = InOldColorIndex
End If
InOldColorIndex = Target.Interior.ColorIndex
' Merke mir aktuellen Adresse für nächsten Aufruf
StOldRange = Target.Address
' Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 3
End If
' .Protect "Test"
End With
End If
End If
Cancel = True
End Sub