'Attribute VB_Name = "mdl_dateUSUK"
'Prüfung Anlegen Pfad Unterverzeichniss'
Option Explicit
' ---------------------------------------------------------
' Funktion: dateUSUK
' Funktion zur Umwandlung eines Datums in einen String im
' US - oder UK - Format
' Eingestellt von: Andre Schau
' Datum: 5. Juno 2006
' Kommentar:
' Parameter: datMyDate = Datum (auch als String moeglich)
' boDateUS = Trigger fuer US oder UK,
' datMyTime = Zeit, kleinste Einheit Sekunde,
' boMyTime = Trigger fuer Zeitausgabe,
' boShort = Trigger fuer kurze Ausgabe
' Rückgabe: Fehlernummer
' Aufruf:
Sub test_dateUSUK()
Dim err_nr As Long
Dim strMyDate As String
strMyDate = ""
'1. Ausgabe Datum und Zeit im US-Format
err_nr = dateUSUK("24.04.2010 17:56:32", strMyDate)
MsgBox strMyDate
'2. Ausgabe Datum und Zeit im US-Format - wie 1.
err_nr = dateUSUK("24.04.2010", strMyDate, , "17:56:32")
MsgBox strMyDate
'3. Ausgabe nur Datum im UK-Format
err_nr = dateUSUK("24.04.2010", strMyDate, False, , False)
MsgBox strMyDate
End Sub
' ---------------------------------------------------------
Function dateUSUK(datMyDate As Date, strMyDate As String, _
Optional boDateUS As Boolean = True, _
Optional datMyTime As Date, _
Optional boMyTime As Boolean = True, _
Optional boShort As Boolean = True) As Long
'Funktion zur Umwandlung eines Datums in einen String im
'US - oder UK - Format
'UK:all-numeric date (e.g., "31/12/99")
'US:all-numeric date (e.g., "12/31/99")
'Uebergabeparameter: datMyDate = Datum (auch als String moeglich),
'boDateUS = Trigger fuer US oder UK,
'datMyTime = Zeit, kleinste Einheit Sekunde,
'boMyTime = Trigger fuer Zeitausgabe,
'boShort = Trigger fuer kurze Ausgabe
'Variablendeklarationen
'String
Dim strTimeForm As String
'Bei Fehler zur Fehlerbehandlung springen
On Error Goto errorhandler
'Wenn der Datumswert verschieden vom übergebenen Datum ist und
'keine Zeit übergeben wurde, steht die zeit wahrscheinlich beim Datum
If DateValue(datMyDate) <> datMyDate And datMyTime = 0 Then
'Zeit übernehmen
datMyTime = TimeValue(datMyDate)
'Ende Wenn der Datumswert ...
End If
'wenn kurzes Format, dann
If boShort Then
'wenn US-Format, dann
If boDateUS Then
strMyDate = Month(datMyDate) & "/" & Day(datMyDate) & "/" & Year(datMyDate)
'oder wenn nicht US-Format,
Else
strMyDate = Day(datMyDate) & "/" & Month(datMyDate) & "/" & Year(datMyDate)
'Ende wenn US-Format, dann
End If
'String fuer Stundenformat kurz
strTimeForm = "h:m:s"
'oder wenn nicht kurzes Format,
Else
'wenn US-Format, dann
If boDateUS Then
strMyDate = Format(datMyDate, "MM") & "/" & Format(datMyDate, "DD") & "/" & _
Format(datMyDate, "YYYY")
'oder wenn nicht US-Format,
Else
strMyDate = Format(datMyDate, "DD") & "/" & Format(datMyDate, "MM") & "/" & _
Format(datMyDate, "YYYY")
'Ende wenn US-Format, dann
End If
'String fuer Stundenformat lang
strTimeForm = "hh:mm:ss"
'Ende wenn kurzes Format, dann
End If
'Wenn boMyTime, dann Zeit dazu
'beachte: 2 Leerzeichen zwischen Datum und Zeit!
If boMyTime Then strMyDate = strMyDate & " " & Format(datMyTime, strTimeForm)
'eventuelle Fehler loeschen
Err.Clear
'Fehlerbehandlung
errorhandler:
'Uebernahme Fehlernummer
dateUSUK = Err.Number
End Function