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