Hallo Excel Freunde,
Nach langer Abwesenheit in diesem Forum, melde ich mich mit einem Fehler in meiner Excel 2019 Datei und bitte um Hilfestellung an die VBA Spezialisten.
Seit Jahren verwende ich diesen farblichen Zeilenbalken als Lineal, dies wurde noch mit Excel 2003 / 2007 erstelt, seit ca. 6 Wochen gibt es einen Fehler mit dem Lineal.
Nach schließen und beenden der Datei, soll der Cursor auf die Zelle "A1" beenden werden.
Bei einem Neustart der Datei, sollte desshalb der Cursor auf der Zelle "A1" stehen.
Zur Zeit sieht das so aus, dass bei Neustart der Datei, der Cursor in einer zufälligen Zelle z.B. "G8" steht und dadurch wird die Zeile "8" von "A bis V" farblich als Lineal darstellt.
bei einem Wechsel auf eine andere Zelle, sollte die farblich markierte Zeile "8" im Beispiel dann gelöscht werden. Dies wird nicht ausgeführt.
Händisch kann dies zwar über: Zellen im Beispiel "A8 bis V8", markiere Zellen formatieren, Ausfüllen, Hintergrundfarbe - keine Farbe, gelöscht werden, ist aber hinderlich.
Kann mir ein VBA Spezialist hier behilflich sein ?
Im Anschluss der VBA Code.
Für eine Hilfe wäre ich sehr dankbar.
Gruß BerPre
Option Explicit
Private CellsColor() As Variant
Private objCells As Object
Private bol As Boolean
_________________________________________________________________________
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const minZ As Long = 1
Const maxZ As Long = 805
Const minSp As Long = 1
Const maxSp As Long = 25
Dim C As Range
Dim cellColor As Range
Dim WS As Worksheet
Set WS = Sh: Set C = WS.Cells
ReDim Preserve CellsColor(1 To maxSp)
If bol And Not objCells Is Nothing Then
For Each cellColor In objCells.Cells
With cellColor
.Interior.ColorIndex = CellsColor(cellColor.Column)
End With
Next cellColor
bol = False
End If
If Target.Row <= minZ Or Target.Row >= maxZ Or Target.Column < minSp Or Target.Column > maxSp Then
WS.Range(C(Target.Row, minSp), C(Target.Row, maxSp)).Interior.Color = xlColorIndexNone
Exit Sub
End If
If Target.Cells.Count > 1 Then Exit Sub
Set objCells = WS.Range(C(Target.Row, minSp), C(Target.Row, maxSp))
For Each cellColor In WS.Range(C(Target.Row, minSp), C(Target.Row, maxSp)).Cells
With cellColor
CellsColor(cellColor.Column) = .Interior.ColorIndex
End With
Next cellColor
bol = True
WS.Range(C(Target.Row, minSp), C(Target.Row, maxSp)).Interior.Color = RGB(204, 255, 204)
End Sub
______________________________________________________________________________________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.Range("A1").Select
ThisWorkbook.Save
End Sub