Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
19.04.2024 13:49:38
Per Kopfdruck als pdf speichern und Mail erstellen
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
904to908
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
904to908
904to908
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Probleme mit IsNumeric, Code per UDF

Probleme mit IsNumeric, Code per UDF
15.09.2007 11:56:00
Peter
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)


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)) Flag = False
Exit For
End If
Next i
If Flag = False Then IstNr = False
If Flag = True Then IstNr = True
End Function


18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Probleme mit IsNumeric, Code per UDF
15.09.2007 12:24:54
Ramses
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

Anzeige
AW: Probleme mit IsNumeric, Code per UDF
15.09.2007 14:39:00
Peter
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

Korrektur...
15.09.2007 15:01:18
Ramses
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

Anzeige
Ergänzung
15.09.2007 16:00:00
Peter
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

AW: Ergänzung
15.09.2007 16:08:00
Ramses
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

Anzeige
AW: Ergänzung
15.09.2007 17:02:00
Peter
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

AW: Ergänzung
16.09.2007 01:33:27
Ramses
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

Anzeige
AW: Ergänzung
16.09.2007 01:34:00
Ramses
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

Anzeige
Ergänzung funktioniert noch nicht
18.09.2007 12:23:30
Peter
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

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

AW: Ergänzung funktioniert noch nicht
19.09.2007 11:35:00
Peter
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

Anzeige
By the way...
15.09.2007 16:16:00
Ramses
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

neue Idee
15.09.2007 16:54:00
Peter
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)


Danke, Danke,
Gruß
Peter

Anzeige
AW: Probleme mit IsNumeric, Code per UDF
16.09.2007 22:33:00
Herby
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

AW: Probleme mit IsNumeric, Code per UDF
15.09.2007 12:30:00
Wolli
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)  47 And Asc(Mid(Text, i, 1))


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

Anzeige
AW: Probleme mit IsNumeric, Code per UDF
15.09.2007 14:18:48
Peter
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

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

AW: Probleme mit IsNumeric, Code per UDF
15.09.2007 16:07:00
Gerd
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

Links zu Excel-Dialogen

TextBox UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige