nochmals:Datumsformat in msg-Box

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox


Excel-Version: XL10
nach unten

Betrifft: nochmals:Datumsformat in msg-Box
von: Mike
Geschrieben am: 07.05.2002 - 09:46:22

Hallo zusammen,
ich will es nochmals versuchen, ob jemand eine Lösung weiß.
Ich habe folgendes Problem:
Wenn ich in meiner msg-Box in die Eingabezeile das Datum im Format => "TT.MM.JJJJ" eintrage, wird es nach Bestätigung auch so in eine festgelegte Zelle übertragen. Die Zelle ist im Format "Datum" formatiert. So weit so gut.
Wenn ich jedoch z.B. das Datum in der in Excel üblichen Kurzform "T.M (ohne Punkt)" eingebe - z.B. "5.1" - wird "05.01.1900" angezeigt. In der Bearbeitungszeile steht noch mehr => "05.01.1900 02:24:00". Kann man das beeinflussen, oder muss das Datum immer vollständig eingegeben werden?

Mein Makro lautet:


Option Explicit

Function DATUMSABFRAGE() As String
    Dim strDatum_vorher As String
    Dim strDatum_Vorgabe As String
    Dim strDatum_neu As String

    Do Until strDatum_neu <> ""
        If ActiveSheet.Range("A55").Value <> "" Then
            strDatum_vorher = ActiveSheet.Range("A55").Value
            strDatum_neu = Application.InputBox("Bitte geben Sie das Datum ein!" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                                                & "Eingetragenes Datum:", , _
                                                strDatum_vorher)
        Else
            strDatum_Vorgabe = Date
            strDatum_neu = Application.InputBox("Bitte geben Sie das Datum ein!" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                                                & "Vorschlag: heutiges Datum.", , _
                                                strDatum_Vorgabe)
        End If
        If strDatum_neu = "Falsch" Then
            DATUMSABFRAGE = ActiveSheet.Range("A55").Value
            Exit Function
        End If
        If strDatum_neu = "" Then Exit Do
        If IsDate(strDatum_neu) = False Then
            MsgBox "Fehler bei der Eingabe des Datums!", _
                    vbExclamation, "Hinweis"
            strDatum_neu = ""
        End If
    Loop
    DATUMSABFRAGE = strDatum_neu
End Function


Gruß
Mike

nach oben   nach unten

Re: nochmals:Datumsformat in msg-Box
von: Jürgen
Geschrieben am: 07.05.2002 - 09:57:08

ohne es getestet zu haben:

wandle Deine Datumsvariable von String in Date um vor Übertragung in eine Zelle, also etwa so:

Zelle.Value = CDate(strDatum)

Gruss Jürgen

nach oben   nach unten

Re: nochmals:Datumsformat in msg-Box
von: Mike
Geschrieben am: 07.05.2002 - 10:06:57

Hallo Jürgen,
leider bin ich in VBA noch nicht so weit, das zu verstehen. Könntest due es vielleicht in meinem Code so abändern, wie du meinst? Danke.

Gruß
Mike


nach oben   nach unten

Re: nochmals:Datumsformat in msg-Box
von: Jürgen
Geschrieben am: 07.05.2002 - 10:56:31

ich weiss leider nicht wie der Eintrag der Variablen DATUMSABFRAGE in die Zelle erfolgt, aber wenn du die vorletzte Zeile der Funktion

DATUMSABFRAGE = strDatum_neu

durch

DATUMSABFRAGE = Format(CDate(strDatum_neu), "dd.mm.yyyy")

ersetzt, sollte es so klappen, wie Du es willst!


Gruss Jürgen


nach oben   nach unten

Re: nochmals:Datumsformat in msg-Box
von: Mike
Geschrieben am: 07.05.2002 - 20:45:08

Hallo Jürgen,
bin erst jetzt heimgekommen und hab's gleich ausprobiert.
Funktioniert. Danke.
Einziger Wermutstropfen => Wenn ich ein falsches Datum eingebe, z.B. "31.4" , dann wird das Datum "01.04.1931" eingetragen, oder bei "29.2" => "01.02.2029". Wie du im bestehenden Code siehst, wird dort bei Fehleingabe eine msg-Box gestartet, die auf den Fehler hinweist und einen Eintrag unterbindet.
Kann man das in der Änderung auch zum Laufen bringen?

Gruß
Mike


nach oben   nach unten

Re: nochmals:Datumsformat in msg-Box
von: Jürgen
Geschrieben am: 08.05.2002 - 00:05:10

"Kann man das in der Änderung auch zum Laufen bringen?"

Da die Fehlerabfrage sich im VBA-Code vor der Änderung befindet wird sie durch die Änderung nicht beeinflusst; sie 'greift' halt nur selten, z.B. bei Buchstabeneingabe!

Eine Möglichkeit utopische Datumseingaben abzufangen ist z.B. im Tabellenblatt die Zelle mit
Daten -> Gültigkeit -> Einstellungen -> zulassen -> Datum
zu formatieren.
Zusätzlich vielleicht noch im VBA-Code die Zeichenlänge (max. 10 Zeichen), was vor dem ersten Punkt steht (sollte < 32 sein), zwischen den Punkten (>13) ...

Der Code ist zwar jetzt ein wenig länger, aber so klappt es bei mir ganz gut!

Ersetze den alten VBA-Code nach der Zeile: If strDatum_neu = "" Then Exit Do
Mit folgendem

Dim TT$, MM$, JJJJ$
On Error Resume Next
TT = Left(strDatum_neu, InStr(strDatum_neu, ".") - 1)
MM = Left(Mid(strDatum_neu, Len(TT) + 2), InStr(Mid(strDatum_neu, Len(TT) + 2), ".") - 1)
JJJJ = Mid(Mid(strDatum_neu, Len(TT) + 2), Len(MM) + 2)

If IsDate(strDatum_neu) = False Or _
Len(strDatum_neu) > 10 Or Len(TT) > 2 Or Len(MM) > 2 Or Len(JJJJ) > 4 Or _
CInt(TT) > 31 Or CInt(MM) > 12 Then
MsgBox "Fehler bei der Eingabe des Datums!", _
vbExclamation, "Hinweis"
strDatum_neu = ""
End If
Loop
DATUMSABFRAGE = Format(CDate(strDatum_neu), "dd.mm.yyyy")
End Function

Gruss Jürgen


PS: was muss ich nochmal am Anfang und am Ende des VBA-Code schreiben damit er hier Forum richtig dargestellt wird?
~start
~ende

nach oben   nach unten

Re: nochmals:Datumsformat in msg-Box
von: Mike
Geschrieben am: 08.05.2002 - 09:26:52

Hallo Jürgen,
funktioniert bei mir leider nicht.
Ich muss das Datum grundsätzlich im Formt "T(TT).M(MM).J" eingeben. Die Kurzform "T(TT).M(MM)" funktioniert nicht. Es kommt die Meldung => "Fehler bei der Eingabe des Datums".
Gebe ich dann zum Testen "29.2.2" ein, wird "02.02.2029" angezeigt.
Bei Eingabe von "31.4.2" => "02.04.1931".
Probier's mal aus.

P.S.: Für die richtige Darstellung des Codes gib am Anfang bzw. am Ende ein => ~ begin ~ und   ~ end ~ (ohne Leerzeile)
Beschrieben ist dies auch unter "Features".

Gruß
Mike



nach oben   nach unten

Teste doch nun mal folgendes
von: Jürgen
Geschrieben am: 08.05.2002 - 10:50:44

jetzt noch ein wenig ausführlicher. Bin mal gespannt, ob Dir noch ein Fehler auffällt :-)
Ist mir übrigens ein Rätsel wieso Excel aus '29.2.2' '02.02.2029' macht !)


Function DATUMSABFRAGE() As String
    Dim strDatum_vorher As String
    Dim strDatum_Vorgabe As String
    Dim strDatum_neu As String
    Dim TT$, MM$, JJJJ$

    Do Until strDatum_neu <> ""
        If ActiveSheet.Range("A55").Value <> "" Then
            strDatum_vorher = ActiveSheet.Range("A55").Value
            strDatum_neu = Application.InputBox("Bitte geben Sie das Datum ein!" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                                                & "Eingetragenes Datum:", , _
                                                strDatum_vorher)
        Else
            strDatum_Vorgabe = Date
            strDatum_neu = Application.InputBox("Bitte geben Sie das Datum ein!" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                                                & "Vorschlag: heutiges Datum.", , _
                                                strDatum_Vorgabe)
        End If
        If strDatum_neu = "Falsch" Then
            DATUMSABFRAGE = ActiveSheet.Range("A55").Value
            Exit Function
        End If
        If strDatum_neu = "" Then Exit Do
        
        On Error Resume Next
        TT = Left(strDatum_neu, InStr(strDatum_neu, ".") - 1)
        MM = Left(Mid(strDatum_neu, Len(TT) + 2), InStr(Mid(strDatum_neu, Len(TT) + 2), ".") - 1)
        If MM = "" Then MM = Mid(strDatum_neu, Len(TT) + 2)
        JJJJ = Mid(Mid(strDatum_neu, Len(TT) + 2), Len(MM) + 2)
        
        If Len(TT) = 1 Then TT = "0" & TT
        If Len(MM) = 1 Then MM = "0" & MM
        If Len(JJJJ) = 0 Then JJJJ = Format(Date, "yyyy")
        If Len(JJJJ) = 1 Then JJJJ = Left(Format(Date, "yyyy"), 3) & JJJJ
        If Len(JJJJ) = 2 Then JJJJ = Left(Format(Date, "yyyy"), 2) & JJJJ

        If IsDate(strDatum_neu) = False Or _
        Len(strDatum_neu) > 10 Or Len(TT) > 2 Or Len(MM) > 2 Or CInt(TT) > 31 Or _
        CInt(MM) > 12 Or Len(JJJJ) = 3 Or Len(JJJJ) > 4 Then
            MsgBox "Fehler bei der Eingabe des Datums!", _
                    vbExclamation, "Hinweis"
            strDatum_neu = ""
        End If
    Loop
    
    DATUMSABFRAGE = TT & "." & MM & "." & JJJJ

End Function


nach oben   nach unten

Re: Teste doch nun mal folgendes
von: Mike
Geschrieben am: 08.05.2002 - 11:24:26

Hallo Jürgen,
du hast es fast.
Jetzt wird zwar das in Kurzform eingegebene Datum "richtig" eingetragen, aber ein falsches leider auch.
Wenn ich also "29.2" eingebe wird "29.02.2002" und bei "31.4" wird "31.04.2002" eingetragen. Aber diese Datums gibt es nicht.
Es müsste daher die Meldung kommen: "Fehler bei der Eingabe des Datums" und der Eintrag unterbunden werden.
Wenn du das noch hinbekämst wäre das super.

Gruß
Mike

P.S.: Muss jetzt leider weg und komme erst heute nacht wieder zurück.


nach oben   nach unten

nächster Versuch :-)
von: Jürgen
Geschrieben am: 08.05.2002 - 18:18:12

vielleicht klappts ja diesmal:


Function DATUMSABFRAGE() As String
    Dim strDatum_vorher As String
    Dim strDatum_Vorgabe As String
    Dim strDatum_neu As String
    Dim TT$, MM$, JJJJ$

    Do Until strDatum_neu <> ""
        If ActiveSheet.Range("A55").Value <> "" Then
            strDatum_vorher = ActiveSheet.Range("A55").Value
            strDatum_neu = Application.InputBox("Bitte geben Sie das Datum ein!" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                                                & "Eingetragenes Datum:", , _
                                                strDatum_vorher)
        Else
            strDatum_Vorgabe = Date
            strDatum_neu = Application.InputBox("Bitte geben Sie das Datum ein!" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                                                & "Vorschlag: heutiges Datum.", , _
                                                strDatum_Vorgabe)
        End If
        If strDatum_neu = "Falsch" Then
            DATUMSABFRAGE = ActiveSheet.Range("A55").Value
            Exit Function
        End If
        If strDatum_neu = "" Then Exit Do
        
        On Error Resume Next
        TT = Left(strDatum_neu, InStr(strDatum_neu, ".") - 1)
        MM = Left(Mid(strDatum_neu, Len(TT) + 2), InStr(Mid(strDatum_neu, Len(TT) + 2), ".") - 1)
        If MM = "" Then MM = Mid(strDatum_neu, Len(TT) + 2)
        JJJJ = Mid(Mid(strDatum_neu, Len(TT) + 2), Len(MM) + 2)
        
        If Len(TT) = 1 Then TT = "0" & TT
        If Len(MM) = 1 Then MM = "0" & MM
        If Len(JJJJ) = 0 Then JJJJ = Format(Date, "yyyy")
        If Len(JJJJ) = 1 Then JJJJ = Left(Format(Date, "yyyy"), 3) & JJJJ
        If Len(JJJJ) = 2 Then JJJJ = Left(Format(Date, "yyyy"), 2) & JJJJ
        strDatum_neu = TT & "." & MM & "." & JJJJ

        If IsDate(strDatum_neu) = False Or _
        Len(strDatum_neu) > 10 Or Len(TT) > 2 Or Len(MM) > 2 Or CInt(TT) > 31 Or _
        CInt(MM) > 12 Or Len(JJJJ) = 3 Or Len(JJJJ) > 4 Then
            MsgBox "Fehler bei der Eingabe des Datums!", _
                    vbExclamation, "Hinweis"
            strDatum_neu = ""
        End If
    Loop
    
    DATUMSABFRAGE = strDatum_neu

End Function

Gruss Jürgen

nach oben   nach unten

Re: nächster Versuch :-)
von: Mike
Geschrieben am: 08.05.2002 - 23:33:01

Hi Jürgen,
phantastisch. Es funktioniert. Vielen Dank für deine tolle Hilfe.

Gruß
Mike


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Spalten in versch. Tabellen vergleichen"