habe einige Makros mal aus dem Forum erhalten für die aktive Zellen Darstellung in Farbe. Funktioniert !
Geht das auch über z.b. über mehrer Spalten hinweg z.b. wenn ich in "F3" bin, das dann die Zellen "A3-E3" ebenfalls in der gleichen Farbe dargestellt werden ?
Hier die Makros:
Public OldColor As Range
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error Resume Next
OldColor.Interior.ColorIndex = xlNone
Target.Interior.ColorIndex = 3
Set OldColor = Target
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
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)
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()
If TypeName(ActiveSheet) = "Worksheet" Then
Oldrange = ActiveCell.Address
Register = ActiveSheet.Name
OldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
' .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 5
' .Protect "Test"
End With
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If TypeName(ActiveSheet) = "Worksheet" Then
Oldrange = ActiveCell.Address
OldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
' .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 5
' .Protect "Test"
End With
Register = ActiveSheet.Name
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If TypeName(ActiveSheet) = "Worksheet" Then
With Worksheets(Register)
' .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)
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 = 5
Else
' Setze alten Range auf alte Farbe
If Range(Oldrange).Interior.ColorIndex = 5 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 = 5
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
Gruß Walter