BeforeDoubleClick

Hey All,
Ich habe mal vor einiger Zeit hier den Code bekommen für den Befehl Zeile farblich markieren ab der Zeile (SpalteA) A3 bis L
Wenn ich aus der Spalte A gehe, geht die Markierung weg.
Jetzt hätte ich es aber gerne das der Code bei einer Worksheet_BeforeDoubleClick funktioniert.
Leider klappt das nicht indem ich einfach den Befehl Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) ändere.
Was muss geändert werden ?
Hier mal der Code

'Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Farblich unterlegen bei ab A3 geht
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) 'neu geht nicht
Static slngRow As Long
Dim objRange As Range
Set objRange = Intersect(Target, Range(Cells(3, 1), Cells(Rows.Count, 1)))
If Not objRange Is Nothing Then
Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone
With objRange.Cells(1, 1)
Range(Cells(.Row, 1), Cells(.Row, 12)).Interior.Color = vbCyan 'vbGreen
slngRow = .Row
End With
Set objRange = Nothing
Else
If slngRow > Target.Cells(1, 1).Row Or Target.Cells(1, 1).column > 12 Then _
Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone
End If

End Sub

Danke im Voraus der Hilfe
MfG.
Dieter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: BeforeDoubleClick

12.08.2023 15:29:09

ralf_b

BeforeDoubleClick

12.08.2023 19:57:34

GerdL

BeforeDoubleClick

16.08.2023 18:47:56

daniel

BeforeDoubleClick

17.08.2023 16:57:39

Dieter

BeforeDoubleClick

14.08.2023 16:22:22

Dieter

BeforeDoubleClick

14.08.2023 19:19:38

Oberschlumpf

BeforeDoubleClick

15.08.2023 16:06:39

Dieter

BeforeDoubleClick

15.08.2023 16:25:24

Oberschlumpf

BeforeDoubleClick

16.08.2023 18:18:15

Dieter

BeforeDoubleClick

16.08.2023 19:14:24

Oberschlumpf

BeforeDoubleClick

12.08.2023 15:42:05

onur

Public slngrow As Long Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) ' Farblich unterlegen bei ab A3 Dim objRange As Range Set objRange = Intersect(Target, Range(Cells(3, 1), Cells(Rows.Count, 1))) Cancel = True If Not objRange Is Nothing Then Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone With objRange.Cells(1, 1) Range(Cells(.Row, 1), Cells(.Row, 12)).Interior.Color = vbCyan 'vbGreen slngrow = .Row End With Set objRange = Nothing End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Muster entfernen If slngrow > Target.Cells(1, 1).Row Or Target.Cells(1, 1).Column > 12 Then Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone End If End Sub

Hi
kannst du bitte nochmal genau beschreiben, was passieren soll?

das erste ist klar, bei einem Doppelklick auf eine Zelle soll der Zellbereich A-L in dieser Zeile eingefärbt werden.
Wie lange soll jetzt diese Zeile eingefärbt bleiben?
a) bis du eine neue Zelle doppelt klickst
b) bis du eine andere Zelle auswählst
c) bis du eine andere Zelle in einer anderen Zeile auswählst
d) noch was anderes (bitte beschreiben)

Prinzipell würde ich das ganze mit Hilfe der Bedingten Formatierung lösen.

lege beispielsweise für den Zellbereich A3:L999 eine Bedingte Formatierung an mit der Regelformel ab: =Zeile()=$A$1
dann reicht es aus, die Zeilennummer der zu färbenden Zeile in die Zelle A1 zu schreiben und wenn man den Wert in A1 löscht oder was anderes reinschreibt, ist die Färbung wieder weg:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Range("A1").Value = Target.Row

Cancel = true

End Sub

dann kann man auch über andere Events wie das Selection_Change die Zeile wieder entfärben, beispielsweise dann wenn man eine Zelle in einer anderen Zeile anklickt:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Row > Range("A1").Value Then Range("A1").ClearContents

End Sub

oder man kann die Färbung mit einem Rechtsklick aufheben

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Range("A1").Value > "" Then

    Range("A1").ClearContents

    Cancel = True

End If

End Sub

oder man programmiert es so, dass man die Färbung aufheben kann, wenn man nochmal einen Doppelklick auf die gefärbte Zeile macht:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) 'neu geht nicht

With Range("A1")

    If .Value = Target.Row Then

        .ClearContents

    Else

        .Value = Target.Row

    End If

End With

Cancel = True

End Sub

die Färbung über die Bedingte Formatierung macht dir vieles leichter, weil du dich nicht darum kümmern musst, die Zellen wieder zurückzufärben, sondern du änderst einfach die Bedingung. Die Zellen können auch vorab anderweitig formatiert sein und bekommen dann wieder ihre ursprüngliche Formatierung zurück, ohne dass du die irgenwie speichern und wieder herstellen musst.

Gruß Daniel

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Range("A1").Value = Target.Row 'Cancel = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row > Range("A1").Value Then Range("A1").ClearContents End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Static slngrow As Long Dim objRange As Range Set objRange = Intersect(Target, Range(Cells(3, 1), Cells(Rows.Count, 1))) If Not objRange Is Nothing Then Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone With objRange.Cells(1, 1) Range(Cells(.Row, 1), Cells(.Row, 12)).Interior.Color = vbCyan 'vbGreen slngrow = .Row End With Set objRange = Nothing Else If slngrow > Target.Cells(1, 1).Row Or Target.Cells(1, 1).Column > 12 Then _ Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone End If End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Code vielleicht noch anpassen ? If slngrow > Target.Cells(1, 1).Row Or Target.Cells(1, 1).Column > 12 Then Range(Cells(3, 1), Cells(Rows.Count, 12)).Interior.Pattern = xlPatternNone End If End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

48 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

BeforeDoubleClick

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

48 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread