Hallo Helmut,
ich hatte vergessen, das s in Excel97 den Datenty Byte noch nicht gab. Und ich glaube Dezimal auch nicht. Ich habe es dir mal angepasst. Versuch es jetz mal. Die Zahlen lassen sich ganz einfach begrenzen. Das siehst du bei der Jahreseingabe. Die ist auf 2000 bis 2099 begrenzt.
Option Explicit
Public Sub test()
Dim varAntwort As Variant, strTag As String, strMonat As String, strJahr As String
Do
varAntwort = Application.InputBox("Bitte den Tag eingeben.", "Eingabe", Type:=1)
If varAntwort = False Then Exit Sub
If zahl_ok(varAntwort, False, 1, False, 0, 1, 31, False, True, False) Then strTag = CStr(varAntwort): Exit Do
MsgBox "Falsche Eingabe für den Tag.", 48, "hinweis"
Loop
Do
varAntwort = Application.InputBox("Bitte das Monat eingeben.", "Eingabe", Type:=1)
If varAntwort = False Then Exit Sub
If zahl_ok(varAntwort, False, 1, False, 0, 1, 12, False, True, False) Then strTag = CStr(varAntwort): Exit Do
MsgBox "Falsche Eingabe für das Monat.", 48, "hinweis"
Loop
Do
varAntwort = Application.InputBox("Bitte das Jahr eingeben.", "Eingabe", Type:=1)
If varAntwort = False Then Exit Sub
If zahl_ok(varAntwort, False, 1, False, 0, 2000, 2099, False, True, False) Then strTag = CStr(varAntwort): Exit Do
MsgBox "Falsche Eingabe für das Jahr.", 48, "hinweis"
Loop
End Sub
Function zahl_ok(zahl As Variant, vorkomma_bool As Boolean, vorkomma As Integer, _
nachkomma_bool As Boolean, nachkomma As Integer, minimum As Variant, _
maximum As Variant, minus As Boolean, plus As Boolean, Meldung As Boolean) As Boolean
Dim index As Integer
On Error GoTo Fehlerausgang
zahl = Trim(CStr(zahl))
If Trim(CStr(zahl)) = "" Then zahl = 0
For index = 1 To Len(CStr(zahl))
If Not IsNumeric(Mid(CStr(zahl), index, 1)) Then
If Mid(CStr(zahl), index, 1) <> "," And Mid(CStr(zahl), index, 1) <> "-" Then
If Meldung Then MsgBox "Nur Zahlen, Komma und Minus verwenden.", vbExclamation, "Hinweis"
Exit Function
End If
End If
Next index
If InStr(InStr(CStr(zahl), ",") + 1, CStr(zahl), ",") <> 0 Then
If Meldung Then MsgBox "Nur ein Komma erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
If InStr(InStr(CStr(zahl), "-") + 1, CStr(zahl), "-") <> 0 Then
If Meldung Then MsgBox "Nur ein Minus erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
If InStr(CStr(zahl), "-") <> 0 And Mid(CStr(zahl), 1, 1) <> "-" Then
If Meldung Then MsgBox "Minus nur links der Zahl erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
If nachkomma = 0 And InStr(CStr(zahl), ",") <> 0 Then
If Meldung Then MsgBox "Nachkommastellen nicht erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
zahl = CDbl(zahl)
If minus And CDbl(zahl) > 0 Then
If Meldung Then MsgBox "Positive Eingabe nicht erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
If plus And CDbl(zahl) < 0 Then
If Meldung Then MsgBox "Negative Eingabe nicht erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
If vorkomma = 0 And CDbl(zahl) >= 1 Then
If Meldung Then MsgBox "Vorkommastellen nicht erlaubt.", vbExclamation, "Hinweis"
Exit Function
End If
If nachkomma_bool And InStr(CStr(zahl), ",") <> 0 Then
If Len(CStr(zahl)) - InStr(CStr(zahl), ",") > nachkomma Then
If Meldung Then MsgBox "Maximal " & CStr(nachkomma) & " Nachkommastellen.", vbExclamation, "Hinweis"
Exit Function
End If
End If
If vorkomma_bool Then
If InStr(CStr(zahl), ",") <> 0 Then
If InStr(CStr(zahl), ",") - 1 + (CDbl(zahl) < 0) > vorkomma Then
If Meldung Then MsgBox "Maximal " & CStr(vorkomma) & " Vorkommastellen.", vbExclamation, "Hinweis"
Exit Function
End If
Else
If Len(CStr(zahl)) + (CDbl(zahl) < 0) > vorkomma Then
If Meldung Then MsgBox "Maximal " & CStr(vorkomma) & " Vorkommastellen.", vbExclamation, "Hinweis"
Exit Function
End If
End If
End If
If minimum <> "" Then
If CDbl(zahl) < CDbl(minimum) Then
If Meldung Then MsgBox "Kleinste mögliche Eingabe ist " & CStr(minimum), vbExclamation, "Hinweis"
Exit Function
End If
End If
If maximum <> "" Then
If CDbl(zahl) > CDbl(maximum) Then
If Meldung Then MsgBox "Größte mögliche Eingabe ist " & CStr(maximum), vbExclamation, "Hinweis"
Exit Function
End If
End If
zahl_ok = True
Exit Function
Fehlerausgang:
If Err.Number = 6 Then
If Meldung Then MsgBox "Eingegebene Zahl zu groß.", vbExclamation, "Hinweis"
ElseIf Err.Number = 13 Then
If Meldung Then MsgBox "Bitte eine Zahl eingeben.", vbExclamation, "Hinweis"
Else
If Meldung Then MsgBox "Fehler " & Err.Number & " - " & Err.Description, vbCritical, "Hinweis"
End If
End Function
Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk