AW: Zeile über der aktiven Zelle mit einer anderer Far
26.02.2009 21:35:55
Josef
Hallo Lena,
probier mal.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Dim oldRng As Range
Dim lngColors() As Long
Const lngColor As Long = 36
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngS As Long, lngE As Long, lngIndex As Long, lngRow As Long
Dim rng As Range
If Target.Rows.Count > 1 Then Exit Sub
If Not oldRng Is Nothing Then
For Each rng In oldRng
rng.Interior.ColorIndex = lngColors(lngIndex)
lngIndex = lngIndex + 1
Next
End If
lngS = Application.Max(2, ActiveWindow.VisibleRange.Columns(1).Column - 2)
lngE = ActiveWindow.VisibleRange.Columns(ActiveWindow.VisibleRange.Columns.Count).Column + 2
lngRow = Application.Max(1, Target.Row - 1)
Set oldRng = Range(Cells(lngRow, lngS), Cells(lngRow, lngE))
lngIndex = 0
Erase lngColors
Redim lngColors(oldRng.Columns.Count - 1)
For Each rng In oldRng
lngColors(lngIndex) = rng.Interior.ColorIndex
lngIndex = lngIndex + 1
Next
oldRng.Interior.ColorIndex = lngColor
End Sub
Gruß Sepp