Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
744to748
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
744to748
744to748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

2x Doppelklick in gleicher Tabelle

2x Doppelklick in gleicher Tabelle
17.03.2006 06:54:07
Konni
Hallo Freaks,
die Frage hatte ich schon einmal gestellt, scheint aber irgendwie untergegangen zu sein; daher noch einmal:
In meiner Tabelle benötige ich zwei unterschiedliche Doppelklickfunktionen. Nachstehende Codes funktionieren, jeder für sich, einwandfrei.
Mir gelingt es nicht, beide Codes ohne Fehlermeldung lauffähig zu machen. Sie müssten irgendwie "verknüpft" werden. Aber wie?
Tausend Dank vorab
Konni
Der erste Code:
Option Explicit
Dim dblOldValue As Double

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Code freundlicherweise von K.Rola
'Zellbereich anpassen
If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
Me.Unprotect Password:="Passwort"
Target.Locked = False
'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
Target.Interior.ColorIndex = 15
Me.Protect Password:="Passwort"
Cancel = True
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'Zellbereich anpassen
If Not Intersect(Target, [G14:G1000]) Is Nothing And Not Target.Locked Then
Me.Unprotect Password:="Passwort"
If IsNumeric(Target) And Target > 0 Then
'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
Target.Interior.ColorIndex = -4142
Else
Target = dblOldValue
End If
If Not Target.Locked Then Target.Locked = True
Me.Protect Password:="Passwort"
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
dblOldValue = Target.Value
End If
End Sub

Der andere Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 5 Or Target.Row < 14 Then Exit Sub
Cancel = True 'cancel = true unterdrückt den Editmodus der Zelle
Set c = Worksheets(2).Range("d12:d1000").Find(Cells(Target.Row, Target.Column))
Text = ""
For x = 1 To 5
If Trim(Worksheets(2).Cells(c.Row + x, c.Column)) = "" Then Exit For
Text = Text & vbLf & Worksheets(2).Cells(c.Row + x, c.Column)
Next x
A = MsgBox(Text, vbOKOnly, Worksheets(2).Cells(c.Row, c.Column))
End Sub

'Code ermöglicht Anzeige Kommentar unter Zeilenüberschrift der Stellungnahme BÜ _
in MsgBox Nachtragsübersicht. 'Code freundlicherweise von Rainer

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2x Doppelklick in gleicher Tabelle
17.03.2006 07:51:05
UweD
Hallo
die beiden makros sind beide gleich benannt. Das ist nicht zulässig.
Woher soll excel wissen, welches der beiden bei doppelklick laufen soll?
Gruß UweD
(Rückmeldung wäre schön)
AW: 2x Doppelklick in gleicher Tabelle
17.03.2006 08:03:19
UweD
Hallo
hab mal ein wenig probiert.
mir ist zwar noch nicht klar, was du machen möchtest...
Dim dblOldValue As Double

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Code freundlicherweise von K.Rola
'Zellbereich anpassen
If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
Dim c, Text$, x%, A
Me.Unprotect Password:="Passwort"
Target.Locked = False
'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
Target.Interior.ColorIndex = 15
Me.Protect Password:="Passwort"
End If
If Target.Column <> 5 Or Target.Row < 14 Then Exit Sub
Set c = Worksheets(2).Range("d12:d1000").Find(Cells(Target.Row, Target.Column))
Text = ""
For x = 1 To 5
If Trim(Worksheets(2).Cells(c.Row + x, c.Column)) = "" Then Exit For
Text = Text & vbLf & Worksheets(2).Cells(c.Row + x, c.Column)
Next x
A = MsgBox(Text, vbOKOnly, Worksheets(2).Cells(c.Row, c.Column))
Cancel = True 'cancel = true unterdrückt den Editmodus der Zelle
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'Zellbereich anpassen
If Not Intersect(Target, [G14:G1000]) Is Nothing And Not Target.Locked Then
Me.Unprotect Password:="Passwort"
If IsNumeric(Target) And Target > 0 Then
'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
Target.Interior.ColorIndex = -4142
Else
Application.EnableEvents = False
Target = dblOldValue
Application.EnableEvents = True
End If
If Not Target.Locked Then Target.Locked = True
Me.Protect Password:="Passwort"
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
dblOldValue = Target.Value
End If
End Sub

Gruß UweD
(Rückmeldung wäre schön)
Anzeige
AW: 2x Doppelklick in gleicher Tabelle
17.03.2006 07:53:18
Beate
Hallo Konni,
du kannst sich 2 Ereignismakros eines Typs in einem Codefenster haben. Deshalb verbinde sie so:
Dim dblOldValue As Double
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Code freundlicherweise von K.Rola
    'Zellbereich anpassen
    If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
        Me.Unprotect Password:="Passwort"
        Target.Locked = False
        '============================================================
        'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
        Target.Interior.ColorIndex = 15
        '============================================================
        Me.Protect Password:="Passwort"
        Cancel = True
    End If
    If Target.Column <> 5 Or Target.Row < 14 Then Exit Sub
    Cancel = True 'cancel = true unterdrückt den Editmodus der Zelle
    Set c = Worksheets(2).Range("d12:d1000").Find(Cells(Target.Row, Target.Column))
    Text = ""
    For x = 1 To 5
        If Trim(Worksheets(2).Cells(c.Row + x, c.Column)) = "" Then Exit For
        Text = Text & vbLf & Worksheets(2).Cells(c.Row + x, c.Column)
    Next x
    A = MsgBox(Text, vbOKOnly, Worksheets(2).Cells(c.Row, c.Column))
End Sub


Gruß,
Beate
Anzeige
@Beate & Uwe
Konni
An Euch beide vielen Dank für die Lösungsvorschläge. Mit dem von Uwe hat es leider nicht geklappt. Aber der von Beate funzt.
Nochmals tausend Dank,
ich wünsche Euch ein schönes Wochenende!
Konni :-))

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige