aktive Zeile farbig zur Orientierung

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rw As Long, Venue As String If Target.Cells.Count > 1 Then Exit Sub Rw = ActiveCell.Row Venue = Cells(Rw, 4) If Rw > 1 And Rw < 1000 Then Cells.Interior.ColorIndex = xlNone Range(Cells(Rw, 1), Cells(Rw, 13)).Interior.ColorIndex = 35 End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

in Modul1: Option Explicit Public Merker(13) As Integer, pos As String Sub Ein() Application.EnableEvents = False End Sub Sub Aus() Application.EnableEvents = True End Sub In DieseArbeitsmappe: Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim sp For sp = 1 To 13 Cells(ActiveCell.Row, sp).Interior.ColorIndex = Merker(sp) Next sp End Sub Private Sub Workbook_Open() Dim sp As Integer pos = "A1" Worksheets("Tabelle1").Range("A1").Select For sp = 1 To 13 Merker(sp) = Cells(1, sp).Interior.ColorIndex Next sp End Sub in Tabelle1: Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim sp As Integer If Target.Cells.Count > 1 Then Exit Sub If Target.Row < 2 And Target.Row > 999 Then Exit Sub For sp = 1 To 13 Cells(Range(pos).Row, sp).Interior.ColorIndex = Merker(sp) Merker(sp) = Cells(Target.Row, sp).Interior.ColorIndex Next sp Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 35 pos = Target.Address(0, 0) End Sub

Hallo Thomas,
die Idee die active Zeile zu markieren ist interessant. Weil man aber dabei Probleme mit der bestehenden Formatierung bekommt, habe ich es anders gemacht. Die active-cell wird mit linien markiert, etwa so sieht es jetzt aus: (code kommt in ThisWorkbook-Module)
Option Explicit
' Function AddLine(BeginX As Single, BeginY As Single, EndX As Single, EndY As Single) As Shape
Private m_VerticalLine As Shape
Private m_HorizontalLine As Shape


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleteLines
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call DeleteLines
Call MarkActiveCell(Sh)
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call DeleteLines
Call MarkActiveCell(Sh)
End Sub


Private Sub DeleteLines()
If (Not m_VerticalLine Is Nothing) Then m_VerticalLine.Delete
If (Not m_HorizontalLine Is Nothing) Then m_HorizontalLine.Delete
End Sub


Private Sub MarkActiveCell(ByVal Sh As Object)
If (Not ActiveCell Is Nothing) Then
Set m_VerticalLine = Sh.Shapes.AddLine(ActiveCell.Left + ActiveCell.Width, Application.ActiveWindow.Top, _
ActiveCell.Left + ActiveCell.Width, Application.ActiveWindow.Top + Application.ActiveWindow.Height)
Set m_HorizontalLine = Sh.Shapes.AddLine(0, ActiveCell.Top + ActiveCell.Height, _
Application.ActiveWindow.Width, ActiveCell.Top + ActiveCell.Height)
End If
End Sub

Die linien kann man noch formatieren, z.B staerker machen, rot oder blau usw. Gruss Dan, cz.
(Und der Code habe ich nicht besonders getestet, es ist eher ein Vorschlag)

Beliebteste Forumthreads (12 Monate)

aktive Zeile farbig zur Orientierung

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread