Zelle Abfragen ob Datum Aktuell

guten morgen zusammen
ich benötige wieder einmal eure Hilfe...
Ich habe einen Code, der mir in der Zelle "B4" kontrolliert ob ein Datum enthalten ist.
Leider reagiert dieser nur, wenn ich nichts eingefügt habe.
mein Problem:
Das Datum in "B4" wird Manuel (muss nicht immer "Datum-Heute" sein) eingetragen, daher wird dies öfters vergessen.
Nun möchte ich den Code so gestallten, dass dieser mich aufmerksam macht, wenn ich das Sheet schliesse oder speichere, dass ich da in B4 noch etwas zu kontrollieren oder ergänzen hab...

Private Sub Worksheet_Change(ByVal Target As Range)
Range("B4:C4").Select
If Target.Count > 1 Then Exit Sub
'Code der die Nummerierung wiedergibt
If Target.Column = 2 And Target.Row >= 7 Then
'Code der die Nummerierung berechnet
Range("A7:A" & Target.Row).FormulaR1C1 = "=IF(RC[1]"""",COUNTA(R7C2:RC2),"""")"
'Code der den Username wiedergibt
Application.EnableEvents = False
Cells(Target.Row, 13).Value = Application.UserName
Application.EnableEvents = True
ElseIf Target.Column = 14 And Target.Row >= 7 Then
If UCase(Target.Value) = "X" Then Rows(Target.Row).Hidden = True
End If
If Sheets("Pendenzen").Range("B4") = "" Or Not IsDate(Sheets("Pendenzen").Range("B4")) Then
Cancel = True
MsgBox "Bitte Datum überprüfen/aktualisieren!"
End If
End Sub

hoffe mir kann da jemand weiterhelfen?
mfg simon

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforeClose(Cancel As Boolean) If Sheets("Pendenzen").Range("B4") <> Date Then MsgBox "Bitte Datum anpassen" Cancel = True End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Sheets("Pendenzen").Range("B4") <> Date Then MsgBox "Bitte Datum anpassen" Cancel = True End If End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) If Sheets("Pendenzen").Range("B4") Date Then MsgBox "Bitte Datum anpassen" Cancel = True End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Sheets("Pendenzen").Range("B4") Date Then MsgBox "Bitte Datum anpassen" Cancel = True End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Worksheets("Pendenzen").Unprotect Password:="1" 'Passwort hab ich angepasst If Target.Count > 1 Then Exit Sub 'Code der die Nummerierung wiedergibt If Target.Column = 2 And Target.Row >= 7 Then 'Code der die Nummerierung berechnet Range("A7:A" & Target.Row).FormulaR1C1 = "=IF(RC[1]"""",COUNTA(R7C2:RC2),"""")" 'Code der den Username wiedergibt Application.EnableEvents = False Cells(Target.Row, 13).Value = Application.UserName Application.EnableEvents = True ElseIf Target.Column = 14 And Target.Row >= 7 Then If UCase(Target.Value) = "X" Then Rows(Target.Row).Hidden = True End If Worksheets("Pendenzen").Protect Password:="1" 'Passwort hab ich angepasst End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim JaNein With Sheets("Pendenzen").Range("B4") If .Value <> Date Then JaNein = MsgBox("Datum ist nicht gleich HEUTE" & vbLf & vbLf & "Anpassen", vbQuestion + vbYesNo) If JaNein = vbYes Then Cancel = True .Select End If End If End With End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim JaNein With Sheets("Pendenzen").Range("B4") If .Value <> Date Then JaNein = MsgBox("Datum ist nicht gleich HEUTE" & vbLf & vbLf & "Anpassen", vbQuestion + vbYesNo) If JaNein = vbYes Then Cancel = True .Select End If End If End With End Sub

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelle Abfragen ob Datum Aktuell

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread