Datumseingabe als Funktion
06.02.2003 09:23:47
Anna
ich habe (natürlich hier im Forum) eine für mich geniale Datumsabfrage erhalten. Die funzt auch großartig. Nur muss ich insgesamt fast 50 Textboxen abfragen und will nicht 50x den Code reinschreiben. Kann man die Abfrage nicht als Funktion umschreiben, so dass ich nur jeder Textbox eine andere Variable zuweise und dann das Datum für diese jeweilige Textbox zurückerhalte. Ich hoffe Ihr könnt mir wieder einmal helfen, ich bin leider nicht so fit und auf Euch angewiesen.
Hier der Code (hier für die Textbox "txtFaelligkeit"):
Private Sub txtFaelligkeit_Change()
Dim dteEingabe As Date
Dim iDay As Integer, iMonth As Integer, iYear As Integer
If txtFaelligkeit.Text = "" Then Exit Sub
If Not IsNumeric(Right(txtFaelligkeit.Text, 1)) Then
beep
txtFaelligkeit.SelStart = Len(txtFaelligkeit.Text) - 1
txtFaelligkeit.SelLength = 1
If txtFaelligkeit.Text <> "TTMMJJJJ" Then
lblFaelligkeit.Caption = "Nur Ziffern erlaubt!"
End If
Exit Sub
Else
lblFaelligkeit.Caption = ""
End If
iDay = CInt(Left(txtFaelligkeit.Text, 2))
Select Case Len(txtFaelligkeit.Text)
Case 0
Case 1
If iDay > 3 Then
beep
txtFaelligkeit.SelStart = 0
txtFaelligkeit.SelLength = 1
lblFaelligkeit.Caption = "Maximal 31 Tage"
Else
lblFaelligkeit.Caption = ""
End If
Case 2
If iDay > 31 Then
beep
txtFaelligkeit.SelStart = 0
txtFaelligkeit.SelLength = 2
lblFaelligkeit.Caption = "Maximal 31 Tage"
Else
lblFaelligkeit.Caption = ""
End If
Case 3
iMonth = CInt(Right(txtFaelligkeit.Text, 1))
If iMonth > 1 Then
beep
txtFaelligkeit.SelStart = 2
txtFaelligkeit.SelLength = 1
lblFaelligkeit.Caption = "Maximal 12 Monate"
Else
lblFaelligkeit.Caption = ""
End If
Case 4
iMonth = CInt(Right(txtFaelligkeit.Text, 2))
If iMonth > 12 Then
beep
txtFaelligkeit.SelStart = 2
txtFaelligkeit.SelLength = 2
lblFaelligkeit.Caption = "Maximal 12 Monate"
Else
lblFaelligkeit.Caption = ""
End If
Select Case iMonth
Case 2
If iDay > 29 Then
beep
txtFaelligkeit.SelStart = 0
txtFaelligkeit.SelLength = 4
lblFaelligkeit.Caption = "Maximal 29 Tage"
Else
lblFaelligkeit.Caption = ""
End If
Case 4, 6, 9, 11
If iDay > 30 Then
beep
txtFaelligkeit.SelStart = 0
txtFaelligkeit.SelLength = 4
lblFaelligkeit.Caption = "Maximal 30 Tage"
Else
lblFaelligkeit.Caption = ""
End If
End Select
Case 8
iMonth = CInt(Mid(txtFaelligkeit.Text, 3, 2))
iYear = CInt(Right(txtFaelligkeit.Text, 4))
If iYear Mod 4 > 0 And iMonth = 2 And iDay = 29 Then
beep
txtFaelligkeit.SelStart = 0
txtFaelligkeit.SelLength = 8
lblFaelligkeit.Caption = "Maximal 28 Tage"
Else
txtFaelligkeit.Text = DateSerial(iYear, iMonth, iDay)
dteEingabe = DateSerial(iYear, iMonth, iDay)
'lblEingang.Caption = dteEingabe & vbLf & Format(dteEingabe, "dddd")
txtFaelligkeit.SelStart = 0
txtFaelligkeit.SelLength = Len(txtFaelligkeit.Text)
'End If
txtEuroFaelligkeit.SetFocus
'cmdPruefung.SetFocus
End If
End Select
End Sub
Anna