title image


Smiley Re: Datumsprüfung während der Eingabe
Hallo Stef@an,leider gibt's Du nicht an ob es sich um VB oder um VBA handelt. Ich haette zumindest vermutet dass sich die Eintraege in Textboxen in VB vordefinieren lassen.Ob dem so ist, kann ich nicht pruefen, da ich VB nicht besitze. Somit kann ich nur eine Loesung fuer VBA zur Verfuegung stellen. Hierbei wird das Datum in der Scheibweise "yyyy-mm-dd" verlangt. Aber vielleicht hilft es ja. Das Textfeld auf dieses diese Routinen Anwendung finden sollen ist in diesem Beispiel "TextBoxDate".Mit dem Sub TextBoxDate_BeforeUpdate... wird geprueft ob das Datum sich in einem zulaessigem Bereich befindet, wogegen TextBoxDate_KeyPress... jeden eingegeben Wert prueft. Hierbei werden nur Zahlen zugelassen und an den entsprechenden Positionen jeweils ein Bindestrich als Datums-Trennzeichen zugelassen. In einem Label sollte die verlangte Schreibweise des Datums angezeigt werden.Das ganze kann natuerlich noch erweitert werden um falsche Werte des Datums (z.B. 2000-02-29 oder 2000-02-30) zu vermeiden. Dies zu programmieren sei Dir selbst ueberlassen.Als Anregung folgendes:Jahre, die durch 4 geteilt werden können, sind Schaltjahre, nicht jedoch solche, die man durch 100 teilen kann. Durch 400 teilbare Jahre sind wieder Schaltjahre, demnach auch das Jahr 2000. Private Function IsLeapYear(WhichYear As Integer) As Boolean Rem determine if WhichYear (4-digit year) is a Leap Year. IsLeapYear = False intLeapYear = WhichYear Mod 4 = 0 And (WhichYear Mod 100 0 Or WhichYear Mod 400 = 0) Select Case intLeapYear Case -1 IsLeapYear = True Case Else IsLeapYear = False End SelectEnd Function Private Sub TextBoxDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) strDateField = "" strDateField = Me!TextBoxDate On Error Resume Next If IsError(CDate(strDateField)) Then MsgBox "The input " & Me!TextBoxDate & " is not a valid date.", vbExclamation Cancel = True Else datDateField = CDate(strDateField) If Year(datDateField) MsgBox "The date " & strDateField & " is too far in the past and therefore invalid.", vbExclamation Cancel = True ElseIf datDateField > Now() Then MsgBox "The date " & strDateField & " is beyond todays date (" & Format(Now(), "yyyy-mm-dd") & ") and therefore invalid.", vbExclamation Cancel = True Else Cancel = False End If End IfEnd Sub Private Sub TextBoxDate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Date must be like "yyyy-mm-dd" Dim intPos As Integer intPos = Len(Me!TextBoxDate) strControlName = "TextBoxDate" Select Case intPos Case 0 To 3 If Not IsNumeric(KeyAscii) Then KeyAscii = 0 End If Case 4, 7 If Not KeyAscii = 45 Then 'Bindestrich KeyAscii = 45 End If Case 5, 6 If Not IsNumeric(KeyAscii) Then KeyAscii = 0 End If Case 8, 9 If Not IsNumeric(KeyAscii) Then KeyAscii = 0 End If Case Else KeyAscii = 0 End SelectEnd SubViele GruesseNorbert

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: