Aktive Zelle markieren von Hajo_Zi
19.10.2005 10:59:35
Hajo_Zi
habe in der Recherche einen alten Code von Hajo_Zi gefunden, mit dem die aktive Zelle immer rot hinterlegt ist. Kann man diesen Code so ändern, dass beim deaktivieren eines Blattes die letzte markierte/aktive Zelle wieder auf den Ursprungshintergrund zurückgesetzt wird? Meine letzte Zelle ist immer ein Hyperlink, der leider immer die Farbe behält, was aber nicht erwünscht ist.
' **************************************************************
' Modul: DieseArbeitsmappe Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************
Option Explicit
' Erstellt von Hajo Ziplies 14.12.02
' der Code ist nur für eine Zelle vorgesehen
' sollten mehere Zellen markiert werden geht die Farbformatierung verloren
' Farbformatierungen während der Selektion bleiben erhalten, außer rot
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' nach Hinweis von Peter Hasserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
If OldRange <> "" Then .Range(OldRange).Interior.ColorIndex = OldColorIndex
' .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
' nach Hinweis von Peter Hasserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
If OldRange <> "" Then .Range(OldRange).Interior.ColorIndex = OldColorIndex
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_Open()
' nach Hinweis von Peter Hasserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
OldRange = ActiveCell.Address
Register = ActiveSheet.Name
OldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
' .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 3
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' nach Hinweis von Peter Hasserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
OldRange = ActiveCell.Address
OldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
' .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 3
' .Protect "Test"
End With
Register = ActiveSheet.Name
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
' nach Hinweis von Peter Hasserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With Worksheets(ActiveSheet)
' .Unprotect "Test"
If OldRange <> "" Then .Range(OldRange).Interior.ColorIndex = OldColorIndex
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
' nach Hinweis von Peter Hasserodt Vergleich eingefügt
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
' .Unprotect "Test"
' Beim 1. Aufruf ist OldRange noch undefiniert
If OldRange = "" Then
OldRange = Target.Address
OldColorIndex = Target.Interior.ColorIndex
' Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 3
Else
' Setze alten Range auf alte Farbe
If Range(OldRange).Interior.ColorIndex = 3 Then
Range(OldRange).Interior.ColorIndex = OldColorIndex
End If
OldColorIndex = Target.Interior.ColorIndex
' Merke mir aktuellen Adresse für nächsten Aufruf
OldRange = Target.Address
' Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 3
End If
' .Protect "Test"
End With
End If
End Sub
' **************************************************************
' Modul: Modul1 Typ = Allgemeines Modul
' **************************************************************
Option Explicit
Public OldColorIndex As Variant
Public OldRange As String
Public Register As String
Sub df()
End Sub
Gruß
Kira