nochmals datum

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim T As String, T1 As String, T2 As String, T3 As String T = TextBox1.Text T1 = Mid$(T, 1, 2) T2 = Mid$(T, 4, 2) If IsNumeric(T1) And IsNumeric(T2) Then If CInt(T2) >= 1 And CInt(T2) = 32 Then MsgBox "" Exit Sub End If End Select End If End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: nochmals datum

24.07.2008 10:29:41

Rudi

AW: nochmals datum

24.07.2008 15:26:45

ralf

AW: nochmals datum

24.07.2008 17:27:00

Rudi

AW: nochmals datum

24.07.2008 23:01:12

ralf

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = CheckDatum(TextBox1) If TextBox1 = "Fehlerhafte Eingabe" Then Cancel = True With TextBox1 .SelStart = 0 .SelLength = 19 End With End If End Sub Function CheckDatum(strDatum As String) Dim dteTmp On Error Resume Next If Not IsNumeric(strDatum) Then dteTmp = CDate(strDatum) Else Select Case Len(strDatum) Case 6 dteTmp = DateSerial(--Right(strDatum, 2), --Mid(strDatum, 3, 2), --Left(strDatum, 2)) Case 8 dteTmp = DateSerial(--Right(strDatum, 4), --Mid(strDatum, 3, 2), --Left(strDatum, 2)) End Select End If If IsDate(dteTmp) Then CheckDatum = Format(dteTmp, "DD.MM.YYYY") Else CheckDatum = "Fehlerhafte Eingabe" End If Err.Clear End Function

OK, dann mal!
in ein Modul:


Public Const strFEHLER As String = "Fehlerhafte Eingabe"
Function CheckDatum(strDatum As String)
'Umwandlung eines Strings in ein Datum und Prüfung der Gültigkeit.
'Datum kann mit beliebigen Trennzeichen (2+3+8-->2.3.2008; 2/6/97-->2.3.1997 etc)
'oder als TTMMJJ/ TTMMJJJJ eingegeben werden.
'Auf die mögliche Umwandlung falscher Tage/ Monate wurde bewusst verzichtet
'z.B. dateserial(2008,15,45)->14.4.2009
'©reated by Rudi Maintaire 24/07/2008
Dim strTmp, i As Integer, iTag As Integer, iMon As Integer, iJahr As Integer
Dim blnFEHLER As Boolean, iDelCounter As Integer
If Not IsNumeric(strDatum) Then
'Eingabe mit Trennzeichen
For i = 1 To Len(strDatum)
Select Case Asc(Mid(strDatum, i, 1))
Case 48 To 57: strTmp = strTmp & Mid(strDatum, i, 1)
Case Else
iDelCounter = iDelCounter + 1
If iDelCounter = 1 Then
iTag = strTmp * 1
strTmp = ""
Else
If IsNumeric(strTmp) Then iMon = strTmp * 1
strTmp = ""
End If
End Select
Next i
If IsNumeric(strTmp) Then iJahr = strTmp * 1
Else
'Eingabe TTMMJJ oder TTMMJJJJ
Select Case Len(strDatum)
Case 6   'TTMMJJ
iTag = Left(strDatum, 2) * 1
iMon = Mid(strDatum, 3, 2)
iJahr = Right(strDatum, 2)
Case 8   'TTMMJJJJ
iTag = Left(strDatum, 2) * 1
iMon = Mid(strDatum, 3, 2)
iJahr = Right(strDatum, 4)
Case Else 'alles andere ist falsch
CheckDatum = strFEHLER
Exit Function
End Select
End If
Select Case iMon
Case 1, 3, 5, 7, 8, 10, 12
Select Case iTag
Case 1 To 31: blnFEHLER = False
Case Else:    blnFEHLER = True
End Select
Case 4, 6, 9, 11
Select Case iTag
Case 1 To 30: blnFEHLER = False
Case Else:    blnFEHLER = True
End Select
Case 2
If iJahr Mod 4 = 0 Then
Select Case iTag
Case 1 To 29: blnFEHLER = False
Case Else:    blnFEHLER = True
End Select
Else
Select Case iTag
Case 1 To 28: blnFEHLER = False
Case Else:    blnFEHLER = True
End Select
End If
Case Else: blnFEHLER = True
End Select
If blnFEHLER Then
CheckDatum = strFEHLER
Else
CheckDatum = Format(DateSerial(iJahr, iMon, iTag), "DD.MM.YYYY")
End If
End Function

in der UF:


Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Replace(TextBox1, " ", "")  "" _
And TextBox1  strFEHLER _
Then TextBox1 = CheckDatum(TextBox1)
If TextBox1 = strFEHLER Then
Cancel = True
With TextBox1
.SelStart = 0
.SelLength = Len(strFEHLER)
End With
End If
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nochmals datum

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread