Herbers Excel-Forum - das Archiv

Probleme mit IsNumeric, Code per UDF

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
TextBox UserForm
Bild

Betrifft: Probleme mit IsNumeric, Code per UDF
von: Peter aus Berlin

Geschrieben am: 15.09.2007 11:56:08

Hallo alle zusammen,
mein Tool habe ich mit einem deutschen Excel 2003 gefertigt.
Das Tool soll auch auf Rechnern mit bulgarischen Excel 2003 laufen.
Dort funktioniert aber nicht der Code IsNumeric.
Von einem Helfer aus dem Forum habe ich den Tipp bekommen die Nachfrage über ein UDF mit folgendem Code nachzubauen. Ich habe leider zu wenig Ahnung, um das UDF in meinen Code einzubauen.
Könnte das jemand für mich machen?
Danke im voraus.
Güße aus Berlin
mein Code:

Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If txtDatum <> "" Then
If Len(txtDatum) <> 8 Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum = ""
Cancel = True
ElseIf InStrRev(txtDatum, ".") <> 6 And InStr(1, txtDatum, ".") <> 3 Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum = ""
Cancel = True
ElseIf Not IsNumeric(txtDatum.Text) = True Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum.Text = ""
Cancel = True
ElseIf CDate(txtDatum.Text) < Date Then
txtDatum = ""
MsgBox "Das Datum darf nicht kleiner sein als heute!"
Cancel = True
End If
End If
End Sub


das UDF:
Function IstNr(Text As String) As Boolean
Application.Volatile
Dim i As Integer
Dim Flag As Boolean
Flag = True ' nur Numerische Werte
For i = 1 To Len(Text)
If Not (Asc(Mid(Text, i, 1)) > 47 And Asc(Mid(Text, i, 1)) < 58) Then
Flag = False
Exit For
End If
Next i
If Flag = False Then IstNr = False
If Flag = True Then IstNr = True
End Function


Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Ramses

Geschrieben am: 15.09.2007 12:24:54
Hallo
das funktioniert auch auf einem deutschen Rechner nicht
01.01.2007 ist nunmal keine Zahl sondern Text, wegen der beiden Punkte :-)
Schreib dein Textbox Ereignis in der Form
Option Explicit

Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.txtdatum <> "" Then
        If Check_Date(Me.txtdatum) = False Then
            MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
            txtdatum = ""
            Cancel = True
            ElseIf CDate(Me.txtdatum) < Date Then
            txtdatum = ""
            MsgBox "Das Datum darf nicht kleiner sein als heute!"
            Cancel = True
        End If
    End If
End Sub


Function Check_Date(chkDate As String) As Boolean
    Dim i As Byte
    Dim tmp As String
    'Nur damit es nachher kürzer zu schreiben ist :-)
    tmp = chkDate
    Select Case Len(tmp)
        Case 10
            'Format = 01.01.2007
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
                'Monatsprüfun
                Select Case Val(Mid(tmp, 4, 2))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case 9
            'Format = 1.01.2007
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 2, 1) = "." And Mid(tmp, 5, 1) = "." Then
                'Monatsprüfung
                Select Case Val(Mid(tmp, 3, 2))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case 8
            'Format = 1.1.2007
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 2, 1) = "." And Mid(tmp, 4, 1) = "." Then
                'Monatsprüfung
                Select Case Val(Mid(tmp, 3, 1))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case 6
            'Format = 1.1.07
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 2, 1) = "." And Mid(tmp, 4, 1) = "." Then
                'Monatsprüfung
                Select Case Val(Mid(tmp, 3, 1))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 2)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 2)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case Else
            Check_Date = False
    End Select
End Function

Gruss Rainer

Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Peter aus Berlin

Geschrieben am: 15.09.2007 14:39:04
Hallo Rainer,
ich habe deinen Code auch eingefügt, leider läuft er nicht Fehlerfrei.
Wenn ich zum Beispiel das Datum 15.09.07 eingebe, so wie von mir gewünscht, kommt meine MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein" , das selbe passiert auch bei 15.9.2007 oder 15.9.07. Ich stelle mal meine Datei mit deinem Code als Zip rein.
Kannst du da nochmal draufschauen?
Danke im Voraus
Gruß
Peter
mein Code: https://www.herber.de/bbs/user/46064.zip

Bild

Betrifft: Korrektur...
von: Ramses

Geschrieben am: 15.09.2007 15:01:18
Hallo
Sorry,... der Fehler war in der "Case 8" Anweisung, da habe ich die Daten falsch extrahiert.
Zusätzlich habe ich die "Case 9" Anweisung noch erweitert.
Sollte jetzt funktionieren
Function Check_Date(chkDate As String) As Boolean
    Dim i As Byte
    Dim tmp As String
    'Nur damit es nachher kürzer zu schreiben ist :-)
    tmp = chkDate
    Select Case Len(tmp)
        Case 10
            'Format = 01.01.2007
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
                'Monatsprüfun
                Select Case Val(Mid(tmp, 4, 2))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case 9
            'Format = 1.09.2007 oder 15.1.2007
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 2, 1) = "." And Mid(tmp, 5, 1) = "." Then
                'Monatsprüfung
                Select Case Val(Mid(tmp, 3, 2))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
            If Mid(tmp, 3, 1) = "." And Mid(tmp, 5, 1) = "." Then
                'Monatsprüfung
                Select Case Val(Mid(tmp, 4, 2))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case 8
            'Format = 1.1.2007
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
                'Monatsprüfung
                Debug.Print Val(Mid(tmp, 4, 2))
                Select Case Val(Mid(tmp, 4, 2))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case 6
            'Format = 1.1.07
            'Prüfen ob Punkte richtig gesetzt sind
            If Mid(tmp, 2, 1) = "." And Mid(tmp, 4, 1) = "." Then
                'Monatsprüfung
                Select Case Val(Mid(tmp, 3, 1))
                        'Monate prüfen
                    Case 1, 3, 5, 7, 8, 10, 12
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 4, 6, 9, 11
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
                            Check_Date = True
                            Exit Function
                        End If
                    Case 2
                        'Das Jahr 2000 Problem wird hier nicht berücksichtigt
                        'Kein Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 2)) Mod 4 <> 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                        'Schaltjahr
                        If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 2)) Mod 4 = 0 Then
                            Check_Date = True
                            Exit Function
                        End If
                End Select
            End If
        Case Else
            Check_Date = False
    End Select
End Function

Gruss Rainer

Bild

Betrifft: Ergänzung
von: Peter aus Berlin

Geschrieben am: 15.09.2007 16:00:05
Hallo Rainer,
funktioniert noch nicht fehlerfrei.
Man kann zum Beispiel 15.09.0007 eingeben.
Das Datum wird angenommen, obwohl es nicht korrekt ist.
Wenn man zum Beispiel zufällig 15.09.kl, also Buchstaben eingibt, startet der Degbugger und bleibt bei der CDate Überprüfung hängen.
Für diese Fälle müsste auch eine Kontrolle da sein.
Kannst du das noch für mich machen?
Danke
Peter
Meine Datei als Zip: https://www.herber.de/bbs/user/46065.zip

Bild

Betrifft: AW: Ergänzung
von: Ramses

Geschrieben am: 15.09.2007 16:08:33
Hallo
sei mir nicht böse, aber ein bischen Intelligenz sollten deine Benutzer schon haben.
Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.txtDatum <> "" Then
        If Check_Date(Me.txtDatum) = False Then
            MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
            txtDatum = ""
            Cancel = True
            ElseIf IsError(CDate(Me.txtDatum)) Then
            MsgBox "Das Datum ist Quatsch"
            txtDatum = ""
            Cancel = True
            ElseIf CDate(Me.txtDatum) < Date Then
            txtDatum = ""
            MsgBox "Das Datum darf nicht kleiner sein als heute!"
            Cancel = True
        End If
    End If
End Sub

Gruss Rainer

Bild

Betrifft: AW: Ergänzung
von: Peter aus Berlin
Geschrieben am: 15.09.2007 17:02:25
Hallo Rainer,
ich grad den Code eingefügt, er bleibt aber bei Eingabe von z.B. 15.09.0g an der Stelle ElseIf IsError(CDate(Me.txtDatum)) Then hängen.
Kannst du dir das nochmal anschauen?!
Danke
Peter

Bild

Betrifft: AW: Ergänzung
von: Ramses

Geschrieben am: 16.09.2007 01:33:27
Hallo
Jo, ist blöd weil die Fehlerbehandlung nicht ausgeschaltet wurde.
Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    If Me.txtDatum <> "" Then
        If Check_Date(Me.txtDatum) = False Then
            MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
            txtDatum = ""
            Cancel = True
            ElseIf IsError(CDate(Me.txtDatum)) Then
            MsgBox "Das Datum ist Quatsch"
            txtDatum = ""
            Cancel = True
            'Damit prüfst du doch schon, ob das eingegebene
            'Datum kleiner ist,
            ElseIf CDate(Me.txtDatum) < Date Then
            txtDatum = ""
            MsgBox "Das Datum darf nicht kleiner sein als heute!"
            Cancel = True
            'und damit unmögliche Jahresangaben wie 0007
            ElseIf Val(Right(Me.txtDatum, InStrRev(Me.txtDatum, ".", -1))) < Year(Now) Then
            txtDatum = ""
            MsgBox "Hat wohl länger gedauert letzte Nacht,... noch nicht wach ?"
            Cancel = True
        End If
    End If
End Sub

Gruss Rainer

Bild

Betrifft: AW: Ergänzung
von: Ramses

Geschrieben am: 16.09.2007 01:34:07
Hallo
Jo, ist blöd weil die Fehlerbehandlung nicht ausgeschaltet wurde.
Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    If Me.txtDatum <> "" Then
        If Check_Date(Me.txtDatum) = False Then
            MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
            txtDatum = ""
            Cancel = True
            ElseIf IsError(CDate(Me.txtDatum)) Then
            MsgBox "Das Datum ist Quatsch"
            txtDatum = ""
            Cancel = True
            'Damit prüfst du doch schon, ob das eingegebene
            'Datum kleiner ist,
            ElseIf CDate(Me.txtDatum) < Date Then
            txtDatum = ""
            MsgBox "Das Datum darf nicht kleiner sein als heute!"
            Cancel = True
            'und damit unmögliche Jahresangaben wie 0007
            ElseIf Val(Right(Me.txtDatum, InStrRev(Me.txtDatum, ".", -1))) < Year(Now) Then
            txtDatum = ""
            MsgBox "Hat wohl länger gedauert letzte Nacht,... noch nicht wach ?"
            Cancel = True
        End If
    End If
End Sub

Gruss Rainer

Bild

Betrifft: Ergänzung funktioniert noch nicht
von: Peter aus Berlin

Geschrieben am: 18.09.2007 12:23:30
Hallo Rainer,
hat etwas länger gedauert, war im Ausland und keine Zeit gehabt.
Jetzt kommt immer bei korrekter Datum-Eingabe, also zum Beispiel 18.09.2007 oder 18.09.07 die MsgBox "Hat wohl länger gedauert letzte Nacht,... noch nicht wach ?".
Kannst du dir das nochmal ansehen?
Danke
Gruß
Peter

Bild

Betrifft: AW: Ergänzung funktioniert noch nicht
von: Gerd L
Geschrieben am: 19.09.2007 11:15:11
Hallo,
ElseIf Val(Right(Me.txtdatum, Len(Me.txtdatum) - InStrRev(Me.txtdatum, "."))) < Year(Now) Then
'........
End If
Gruß Gerd

Bild

Betrifft: AW: Ergänzung funktioniert noch nicht
von: Peter aus Berlin

Geschrieben am: 19.09.2007 11:35:19
Hallo Gerd,
selbes Resultat, funktioniert noch nicht.
Kannst du dir das nochmal ansehen?
Ich stelle mal meine Datei als Zip rein.
Der Code befindet sich in der Userform "frmEingabe_neue_Zahlung_extern".
Durch Click auf die Schaltfläche "extern" auf meiner eigenen Symbolleiste erscheint die Userform.
Das Textfeld "txtDatum" ist das erste von oben.
Danke
Grüße aus Berlin
meine Datei: https://www.herber.de/bbs/user/46162.zip

Bild

Betrifft: By the way...
von: Ramses

Geschrieben am: 15.09.2007 16:16:37
Hallo
"..funktioniert noch nicht fehlerfrei..."
Mein Code tut schon, deiner nicht :-)
Der 15.09.0007 ein gültiges Datum, auch wenn es EXCEL nicht versteht :-)
Wenn du das absolut fehlerfrei haben willst, dann musst du auch solchen Quatsch
15.09.3089
unterbinden.
Gruss Rainer

Bild

Betrifft: neue Idee
von: Peter aus Berlin

Geschrieben am: 15.09.2007 16:54:11
Hallo Rainer,
würde so etwas wie folgendes etwas verändert wenigstens die Kontrolle nach 0007 bewirken?

Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.txtDatum <> "" Then
If Check_Date(Me.txtDatum) = False Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum = ""
Cancel = True
ElseIf CDate(Me.txtDatum) < Day(Date) & "." & Month(Date) & "." & Year(Date) Then
txtDatum = ""
MsgBox "Das Datum darf nicht kleiner sein als heute!"
Cancel = True
End If
End If
End Sub


Danke, Danke,
Gruß
Peter

Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Herby

Geschrieben am: 16.09.2007 22:33:32
Hallo Rainer,
meines Erachtens müsste die UDF von mir korrekt sein und die interne Abfrage "IsNumeric" ersetzen können.
https://www.herber.de/forum/archiv/904to908/t905048.htm#905048
Die Prüfung einer validen Datumserfassung ist damit nicht beabsichtigt gewesen.
Deine umfangreiche Funktion zur Datumsprüfung habe ich jetzt auch übernommen.
Danke dafür.
Viele Grüße
Herby

Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Wolli

Geschrieben am: 15.09.2007 12:30:52
Hallo Peter nach Berlin, ist ganz einfach: 1.) Die Funktion in ein Modul der Arbeitsmappe kopieren. Sie kann dann (im Arbeitsblatt oder im VBA-Code) wie eine normale Funktion verwendet werden. Also 2.) In Deinem Originalcode ersetzt Du "IsNumeric" durch "IstNr" und schon wird die "neue" Funktion verwendet und funktioniert hoffentlich wie angekündigt. Also:

Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If txtDatum <> "" Then
If Len(txtDatum) <> 8 Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum = ""
Cancel = True
ElseIf InStrRev(txtDatum, ".") <> 6 And InStr(1, txtDatum, ".") <> 3 Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum = ""
Cancel = True
ElseIf Not IstNr(txtDatum.Text) = True Then
MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein"
txtDatum.Text = ""
Cancel = True
ElseIf CDate(txtDatum.Text) < Date Then
txtDatum = ""
MsgBox "Das Datum darf nicht kleiner sein als heute!"
Cancel = True
End If
End If
End Sub
Function IstNr(Text As String) As Boolean
Application.Volatile
Dim i As Integer
IstNr = True ' nur Numerische Werte
For i = 1 To Len(Text)
If Not (Asc(Mid(Text, i, 1)) > 47 And Asc(Mid(Text, i, 1)) < 58) Then
IstNr = False
Exit For
End If
Next i
End Function


PS: Habe mir erlaubt, die IstNr-Funktion noch etwas zu straffen. Sollte aber genauso funktionieren.
Gruß, Wolli

Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Peter aus Berlin

Geschrieben am: 15.09.2007 14:18:48
Hallo Wolli,
hab deinen Code eingefügt.
Wenn ich in das Textfeld ein Datum eingebe kommt aber meine MsgBox "Geben Sie ein gültiges Datum im Format dd.mm.yy ein". Irgend etwas funktioniert noch nicht.
Ich stelle mal meine Datei als Zip rein, wäre super, wenn du mal reinschauen könntest.
Ach ja, der "Problemcode" befindet sich in der Userform "frmEingabe_neue_Zahlung_extern", geöffnet wird diese über die Schaltfläche "extern" auf meiner eigenen Symbolleiste.
Danke im Voraus
Gruß
Peter
meine Datei: https://www.herber.de/bbs/user/46063.zip

Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Ramses
Geschrieben am: 15.09.2007 14:31:47
Hallo
Es wird mit dieser Funktion NIEMALS funktionieren, weil das Ergebnis der Prüfung IMMER "FALSCH" sein wird.
Gruss Rainer

Bild

Betrifft: AW: Probleme mit IsNumeric, Code per UDF
von: Gerd L

Geschrieben am: 15.09.2007 16:07:01
Hallo Rainer, klasse Function!
Hallo Peter, so würde ich dies umsetzen

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not Check_Date(TextBox1.Text) Then
TextBox1 = ""
MsgBox "No Date!", vbOKOnly
Cancel = True
End If
TextBox1 = Format(TextBox1.Text, "dd.mm.yy")
End Sub


Grüße Gerd

 Bild