AW: Kleine Korrektur/Verbesserung:
22.03.2010 10:56:26
Ernst
Hallo !
Danke für die Lösung
genau das was ich mir vorgestellt habe, wenn ich allerdings auf abrechen gehe wenn die msg Box Fehlerbeschreibung kommt erhalte ich einen Laufzeitfehler 1004 ansonst perfect !
Anbei der Code um den es geht
lg.Ernst
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim zelle As Long
If Not Intersect(Target, Range("B8:B105,F8:F105,J8:J105")) Is Nothing Then
Application.EnableEvents = False
With Target
NumberFormat = "dd.mm.yyyy"
.Value = Date
End With
Application.EnableEvents = True
For i = 6 To 247
Next
Cancel = True
ElseIf Not Intersect(Target, Range("C8:C105,G8:G105,K8:K105")) Is Nothing Then
UserForm1.Show
Cancel = True
Else
' x in die Zelle
Dim RaBereich As Range
Set RaBereich = Range("l8:l87,m8:m87")
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub
' Abbruch, wenn Aktion nicht im Zielbereich
Application.EnableEvents = False
Cancel = True
If Target.Value = "X" Then
Target.Value = ""
Else
Target.Value = "X"
End If
Application.EnableEvents = True
Set RaBereich = Nothing
If Target.Column 13 Or Target.Count > 1 Then Exit Sub
If Target = "x" Then
If vbOK = MsgBox("Eintrag und Kommentar löschen?", _
vbExclamation + vbOKCancel) Then
Target = ""
If Not Target.Comment Is Nothing Then Target.Comment.Delete
Cancel = True
End If
Else
Cancel = True
Target = "x"
If Not Target.Comment Is Nothing Then Target.Comment.Delete
Target.AddComment (InputBox("Bitte Fehlerbeschreibung eingeben:", _
"Begründung", "Fehlerbeschreibung?"))
Cancel = True
End If
End If
End Sub