Erinnerung an Feierabend

Private Sub Workbook_Open() Application.DisplayAlerts = False jetzt = Now Verfalldatum = #11:00:00 PM# 'Hier Verfalldatum im Format MM/TT/JJJJ eintragen If Verfalldatum < jetzt Then Dim passwort As String passwort = InputBox("Die Testphase ist abgelaufen," & Chr(13) & Chr(13) & " bitte geben Sie Ihre Registrierungs-Nr.:", "Testphase abgelaufen, Reg.Nr. erforderlich") If passwort <> "geheim" Then MsgBox " Das Kennwort ist ungültig," & Chr(13) & Chr(13) & "der Vorgang wird abgebrochen !" ThisWorkbook.Close End If MsgBox ("Registrierung erfolgreich") Application.DisplayAlerts = True End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Application.DisplayAlerts = False jetzt = Now Verfallzeit = TimeValue("23:00:00") 'Hier Verfallzeit im Format 00:00:00 eintragen If Verfallzeit > jetzt Then Dim passwort As String passwort = InputBox("Die Testphase ist abgelaufen," & Chr(13) & Chr(13) & " bitte geben Sie Ihre Registrierungs-Nr.:", "Testphase abgelaufen, Reg.Nr. erforderlich") If passwort <> "geheim" Then MsgBox " Das Kennwort ist ungültig," & Chr(13) & Chr(13) & "der Vorgang wird abgebrochen !" ThisWorkbook.Close End If MsgBox ("Registrierung erfolgreich") Application.DisplayAlerts = True End If End Sub

Hallo
Dazu brauchst du 2 Extra Makros die rekursiv aufgerufen werden.
Stichwort "Application.OnTime"
Das muss in Workbook_Open

Option Explicit

Private Sub Workbook_Open()
    CheckTIme
End Sub

Das muss in ein Modul

Option Explicit

Sub CheckTIme()
    Dim passwort As String
    Verfallzeit = TimeValue("23:00:00")      'Hier Verfallzeit im Format 00:00:00 eintragen
    If Verfallzeit > Now Then
        Application.DisplayAlerts = False
        passwort = InputBox("Die Testphase ist abgelaufen," & Chr(13) & Chr(13) & "  bitte geben Sie Ihre Registrierungs-Nr.:", "Testphase abgelaufen, Reg.Nr. erforderlich")
        If passwort <> "geheim" Then
            MsgBox "     Das Kennwort ist ungültig," & Chr(13) & Chr(13) & "der Vorgang wird abgebrochen !"
            ThisWorkbook.Close
        End If
        MsgBox ("Registrierung erfolgreich")
        Application.DisplayAlerts = True
    End If
    'Nächste Prüfung in einer Minute
    Application.OnTime Now + TimeValue("00:01:00"), CheckTIme
End Sub

Das ganze ist ungetestet,... sollte aber tun.
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread