Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Probleme mit IsNumeric, Code per UDF

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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


  

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