BeforeDoubleClick mehrmals
02.05.2020 10:49:55
Ralf
Leider ist der doppelklick schon vergeben.
Kann man den BeforeDoubleClick in einer Tabelle mit verschieden Funktionen belegen?
Der erste soll sich im Bereich A10-A110
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call UFAnzeigen(Target.Row)
Cancel = True
End Sub
Private Sub UFAnzeigen(lngZeile As Long)
Load Test
With Tabelle1
Test.Label1 = .Cells(lngZeile, 1)
Test.Label2 = .Cells(lngZeile, 2)
Test.Label3 = .Cells(lngZeile, 3)
End With
Test.Show
End Sub
danke an ChrisConst Bereich As String = "E9:H16,J9:M16,O9:R16,T9:W16,Y9:AB16,AD9:AG16,AI9:AL16,AN9:AQ16,AG25: _
AL32,AN25:AQ36,AG37:AH41,AP41:AQ45,F52:I63,K52:P59,R52:U63,D10:D111"
Public erste As String, zweite As String, ersteformel As String, zweiteformel As String
Public Farbe1, Farbe2
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(Bereich)) Is Nothing Then
ActiveSheet.Unprotect Password:="hallo"
Cancel = True
If erste = "" Then
erste = Target.Address
ersteformel = Target.Cells(1).Formula
Farbe1 = Target.Cells(1).Interior.Color
End If
zweite = Target.Address
zweiteformel = Target.Cells(1).Formula
Farbe2 = Target.Cells(1).Interior.Color
If erste zweite And zweite "" Then
Application.EnableEvents = False
Range(erste).Cells(1).Formula = zweiteformel
Range(erste).Cells(1).Interior.Color = Farbe2
Range(zweite).Cells(1).Formula = ersteformel
Range(zweite).Cells(1).Interior.Color = Farbe1
erste = ""
zweite = ""
Farbe1 = -4142
Farbe2 = -4142
Application.EnableEvents = True
End If
ActiveSheet.Protect Password:="hallo"
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(Bereich)) Is Nothing Then
ActiveSheet.Unprotect Password:="hallo"
Cancel = True
With Target.Cells(1)
If .Interior.ColorIndex = -4142 Then
.Interior.Color = vbRed
Else
.Interior.Color = IIf(.Interior.Color = vbYellow, vbGreen, vbYellow)
End If
End With
ActiveSheet.Protect Password:="hallo"
End If
End Sub
Danke nochmal an Hary für den ScriptGruß Ralf