Relaunch Eingabefeld

Question

Ich habe ein Excel-Blatt als beim ersten Öffnen fragt den Benutzer, ein Datum in das Eingabefeld einzugeben und es in eine Zelle in dem Blatt platziert. Ich habe ein Fehler-Handle, um eine ungültige Datum-Fehler-Box zu öffnen, wenn jemand das falsche Datum eingibt. Aber was ich tun möchte, ist, wenn ein ungültiges Datum eingegeben wird, das ursprüngliche Eingabefeld für das Datum wieder auftaucht, damit sie erneut eingeben können. Ich habe den Code unten von dem, was ich bisher geschrieben habe, aber ich bekomme immer einen Fehler.

Dank

ReShowInputBox: cellvalue = Application.InputBox("Please Enter The Date for Data Extracted (dd/mm/yyyy)") 
On Error GoTo ErrHandle 

ErrHandle: 
MsgBox ("Invalid Date") 
ReShowInputBox: cellvalue = Application.InputBox("Please Enter The Date for Data Extracted (dd/mm/yyyy)") 

If cellvalue = "" Then Exit Sub 
ws.Select 
ws.Range("A1").Value = DateValue(cellvalue) 
MsgBox ("Date Entered!") 

Answer 1

Wie wärs mit einem einfachen Do Until Loop:

Dim cellvalue As Variant 

Do 

    cellvalue = Application.InputBox("Please Enter The Date for Data Extracted (dd/mm/yyyy)") 

Loop Until IsDate(cellvalue) And IsNumeric(Right(cellvalue, 4)) And IsNumeric(Left(cellvalue, 2)) And IsNumeric(Mid(cellvalue, 4,2)) 

ws.Range("A1").Value = cellvalue 
MsgBox ("Date Entered!") 

ich diese ziemlich gründlich getestet und es nur Daten in das genaue Format akzeptiert die Sie wünschen.

Answer 2

Hier ist eine einfache Möglichkeit, für ein Datum wiederholt zu fragen, bis Sie ein, aber dem Benutzer zu ermöglichen, aufzuheben:

Sub fhskjfs() 
    Dim i As String, d As Date 
    i = "" 

    While Not IsDate(i) 
     i = Application.InputBox(Prompt:="Enter a date", Type:=2) 
     If i = False Then Exit Sub 
     If IsDate(i) Then d = CDate(i) 
    Wend 
End Sub 

EDIT # 1:

Hier ist ein Weg, um zu Implementieren Sie eine einfache Formatprüfung:

Public Function CheckFormat(i As String) As String 
    CheckFormat = "junk" 
    ary = Split(i, "/") 
    If UBound(ary) <> 2 Then Exit Function 
    If CLng(ary(2)) < 1900 Or CLng(ary(2)) > 9999 Then Exit Function 
    If CLng(ary(1)) > 12 Then Exit Function 
    If CLng(ary(0)) > 31 Then Exit Function 
    CheckFormat = i 
End Function 

Sub GetDate() 
    Dim i As String, d As Date 
    i = "" 

    While Not IsDate(i) 
     i = Application.InputBox(Prompt:="Enter a date", Type:=2) 
     If i = "False" Then Exit Sub 
     i = CheckFormat(i) 
     If IsDate(i) Then d = CDate(i) 
    Wend 
End Sub