Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1756to1760
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
BeforeDoubleClick mehrmals
02.05.2020 10:49:55
Ralf
Ich möchte die beiden VBAs in eine Tabelle bekommen.
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 Chris
Const 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 Script
Gruß Ralf

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: BeforeDoubleClick mehrmals
02.05.2020 10:58:29
Hajo_Zi
Ja
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call UFAnzeigen(Target.Row)
marko21
Cancel = True
End Sub
GrußformelHomepage
AW: BeforeDoubleClick mehrmals
02.05.2020 11:16:04
Ralf
Hallo hajo
beißt sich trotzdem mit

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

Anzeige
AW: BeforeDoubleClick mehrmals
02.05.2020 11:20:00
Hajo_Zi
das hat nichts mehr mit dem ersten Beitrag zu tun.
Das läuft nicht da Variable Bereich nich belegt.
nur wenige schauen auf Deinen Rechner und sehen die Datei.
Ich möchte gerne den Fehler im Original sehen.
Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.
Ein Nachbau sieht meist anders aus als das Original. Darum sollte das Original verlinkt werden.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
änderrn.
Das ist nur meine Meinung zu dem Thema.
Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)
Gruß Hajo
Anzeige
AW: BeforeDoubleClick mehrmals
02.05.2020 11:45:19
Ralf
Ok,
hier ist es
https:\/\/www.herber.de/bbs/user/137194.xlsm
Der erste Script ist dafür das die Zellen rechts klick zu verschieben der zweite um sie mit doppelklick einzufärben.
ich hätte aber gen noch das, das popup aufgeht wenn ich auf den Bereich A10-A16 doppelt klicke
Gruß Ralf
AW: BeforeDoubleClick mehrmals
02.05.2020 12:27:38
hary
Moin Ralf
Setze eine Ueberwachung einfach vor die alte Ueberwachung.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A10:A16")) Is Nothing Then'--Ueberwachung A10:A16
Call UFAnzeigen(Target.Row)
Cancel = True
End If
If Not Intersect(Target, Range(Bereich)) Is Nothing Then

gruss hary
Anzeige
AW: BeforeDoubleClick mehrmals
02.05.2020 14:57:51
Ralf
Hallo hary,
Const 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("A10:A16")) Is Nothing Then '--Ueberwachung A10:A16
Call UFAnzeigen(Target.Row)
Cancel = True
End If
If Not Intersect(Target, Range(Bereich)) Is Nothing Then
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
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
ich bekomme immer noch den Fehler das BeforeDoubleClick doppelt ist. hab ich bestimmt falsch gesetzt.
Gruß Ralf
Anzeige
AW: BeforeDoubleClick mehrmals
02.05.2020 15:39:49
hary
Moin
Was sucht Sub UFAnzeigen im Doppelklickcode?
UFAnzeigen ist ein eigenes Modul. Also außerhalb vom Doppelklick
Gruss hary c
AW: BeforeDoubleClick mehrmals
02.05.2020 16:00:09
Ralf
keine Ahnung, das ist ein teil des codes den ich von Chris bekommen hab.
Ich wollte das, wenn man links auf die Namen klickt ein popup aufgeht.
das einfärben der zellen soll aber im angedachten Bereich bleiben.
https:\/\/www.herber.de/bbs/user/137194.xlsm
geht das überhaupt?
Gruß Ralf
AW: BeforeDoubleClick mehrmals
02.05.2020 17:20:01
hary
Moin
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A10:A16")) Is Nothing Then
Call UFAnzeigen(Target.Row)
Cancel = True
End If
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
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

gruss hary
Anzeige
AW: BeforeDoubleClick mehrmals
02.05.2020 19:26:54
Ralf
Super, du bist der beste!
Danke.
Gruß Ralf

48 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige