aktive Zeile farbig zur Orientierung

Thomas · 2006-05-22T13:53:52+00:00

Hallo Zusammen, ich habe folgenden Code für die farbliche Darstellung der aktiven Zeile sodass man auf einen Blick sieht in welcher Zeile man arbeitet. 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 Kann mit hier jemand eine Erweiterung des Codes nennen, der bestehende Markierungen nicht entfernt? Also für die bessere Darstellungen sind Spalten und Zellen farbig markiert, diese sollten dann auch in der bestehenden Farbe so bleiben... Der o. g. Code entfernt ja die Farbe wieder und dies gilt leider auch für bestehende Farben... Kann mir das jemand entsprechend abändern? Danke an alle Helfenden... MfG aus dem grauen Berlin Thomas R.

Hi Thomas,
leichter Bug, Zeile 1 bleibt immer markiert, deshalb Frage noch offen. Um Einzelzellen färben zu können das makro Aus, danach das Makro Ein.

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

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..

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)

aktive Zeile farbig zur Orientierung

Forumthread: aktive Zeile farbig zur Orientierung

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial