Hallo Manne,
wie versprochen hier nochmal der Code in lesbarer Form. Wie gesagt, muss dieser in das entsprechende Tabellenmodul.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set ber = Range("D4:G20") 'Bewertungsbereich
If Not Intersect(Target, ber) Is Nothing Then
Set rw = Range(Cells(Target.Row, ber.Column), Cells(Target.Row, ber.Column + ber.Columns.Count - 1))
rw.Font.ColorIndex = 6 'z.B. Leerfarbe
Target.Font.ColorIndex = 4 'z.B. Auswahlfarbe
End If
End Sub
Keine Ahnung warum die Symbolleiste auf dem anderen PC heute nicht zu sehen war.
Falls du die Auswahl lieber erst bei Doppelklick änderst, kannst den Code alternativ auch so nutzen
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set ber = Range("D4:G20") 'Bewertungsbereich
If Not Intersect(Target, ber) Is Nothing Then
Set rw = Range(Cells(Target.Row, ber.Column), Cells(Target.Row, ber.Column + ber.Columns.Count - 1))
rw.Font.ColorIndex = 6 'Leerfarbe
Target.Font.ColorIndex = 4 'Auswahlfarbe
End If
Cancel = True
End Sub
Kannst dir aber auch nochmal die Varianten von RPP63 ansehen. Vielleicht gefällt dir das noch besser.
Gruß Mr. K.
|