Doppelklick nur einmal zulassen

Hallo zusammen.
Ich mal wieder.
Habe eine Tabelle bei der ich beim Workbook Start die Spalten A - O mit Passwort sperre.
Die Spalten K und L werden mit Doppelklick entsperrt und aktuelles Datum und Uhrzeit werden eingetragen.
Soweit so gut. Funktioniert auch.
Meine Frage: Wie kann ich jetzt erreichen, dass die Eingabe per Doppelklick nur einmal moeglich ist? Also nachdem der User den Eintrag gemacht hat, die Zelle nicht mehr veraenderbar ist (natuerlich nur fuer den User). Weil, wenn ich spaeter wieder auf die Zelle doppelklicke, wird ja wieder aktuelles Datum und Zeit eingetragen.
Hier mein Code:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("K:L")) Is Nothing Then
Worksheets("Main Sheet").Unprotect "?"
Target = Date + Time
Cancel = True
Worksheets("Main Sheet").Protect "?"
End If
End Sub

Vielen Dank fuer Loesungsansaetze.
Gruss Torsten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("K:L")) Is Nothing And Target.Value = "" Then Worksheets("Main Sheet").Unprotect "?" Target = Date + Time Cancel = True Worksheets("Main Sheet").Protect "?" Else MsgBox "Keine Eingabe mehr moeglich" End If End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("K:L")) Is Nothing Msgbox "Doppelklick ausßerhalb des gültigen Bereichs (K:L)" Else if Target.Value = "" Then Worksheets("Main Sheet").Unprotect "?" Target = Now Worksheets("Main Sheet").Protect "?" Else MsgBox "Keine Eingabe mehr moeglich" End If Cancel = True End if End Sub

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("K:L")) Is Nothing Then MsgBox "Outside of the available range" Else If Target.Value = "" Then Worksheets("Main Sheet").Unprotect "?" Target = Now Worksheets("Main Sheet").Protect "?" Else MsgBox "No more change possible" End If Cancel = True End If End Sub

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("K:L")) Is Nothing Then MsgBox "Outside of the available range" Else If Target.Value = "" Then if Target.column = 12 and Target.Offset(0, -1).value = "" then Msgbox "Please fill in column K first" else Worksheets("Main Sheet").Unprotect "?" Target = Now Worksheets("Main Sheet").Protect "?" end if Else MsgBox "No more change possible" End If Cancel = True End If End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread