-
Notifications
You must be signed in to change notification settings - Fork 0
/
M_moddate.def
127 lines (108 loc) · 3.47 KB
/
M_moddate.def
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
Option Compare Database
Option Explicit
Public Const InvalidDate = "30.12.1899"
Public Const EmptyDate = "30.12.1899"
Public Const vbNullDate = "30.12.1899"
Public Function Today() As Date
Today = VBA.Date
End Function
Public Function TodayObj() As clsDateTime
Set TodayObj = Utils.DateTime.Today
End Function
'---------------------------------------------------------------------------------------
' Procedure : IsDate
' Author : K.Gundermann
' Date : 05.01.2011
' Purpose : Überschreibt VBA.IsDate !!!!
' damit beim Zugriff auf Objektklassen, die ein leeres Datum aus der Datenbank liefern
' der Fehler abgefangen wird
'---------------------------------------------------------------------------------------
'
Public Function IsDate(ByVal TheDate As Variant) As Boolean
On Error GoTo IsDate_Error
IsDate = VBA.IsDate(TheDate)
If IsDate Then
IsDate = (TheDate <> CDate(InvalidDate))
End If
IsDate_Exit:
On Error GoTo 0
Exit Function
IsDate_Error:
If Err = 1234 Then
IsDate = False
Resume Next
Else
MsgBox Err.Description, vbCritical vbOKOnly, "Error in IsDate"
Resume IsDate_Exit
End If
End Function
Public Function IsValidDate(ByVal TheDate As Variant) As Boolean
IsValidDate = IsDate(TheDate)
End Function
Public Function IsNullDate(ByVal TheDate As Variant) As Boolean
IsNullDate = Not IsDate(TheDate)
End Function
'---------------------------------------------------------------------------------------
' Procedure : NZDate
' Author : K.Gundermann
' Date : 13.06.2012
' Purpose : Alternative zu CDate
' CDate liefert bei einem leeren String den Fehler "Typen Unverträglich" !!!
'---------------------------------------------------------------------------------------
'
Public Function NZDate(ByVal TheValue As Variant) As Date
On Error GoTo NZDate_Error
If VarType(TheValue) = vbObject Then TheValue = TheValue.Value
If VarType(TheValue) = vbDate Then
NZDate = TheValue
ElseIf VarType(TheValue) = vbString Then
If IsNullString(TheValue) Then
NZDate = EmptyDate
Else
NZDate = CDate(TheValue)
End If
ElseIf VarType(TheValue) = vbNull Then
NZDate = EmptyDate
ElseIf IsEmpty(TheValue) Then
NZDate = EmptyDate
Else
Err.Raise vbObjectError, , "Don't know how to convert " & TheValue
End If
On Error GoTo 0
Exit Function
NZDate_Error:
If Err.Number = 13 Then ' Typen unverträglich
NZDate = EmptyDate
Exit Function
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure NZDate of Modul moddate"
End If
End Function
Public Function Date2Str(ByVal TheDate As Date) As String
If TheDate = CDate(vbNullDate) Then
Date2Str = vbNullString
Else
Date2Str = CStr(TheDate)
End If
End Function
Public Function Date2Variant(TheDate As Date) As Variant
If TheDate = CDate(vbNullDate) Then
Date2Variant = Null
Else
Date2Variant = CStr(TheDate)
End If
End Function
Public Function Str2Date(ByVal TheString As String) As Date
If IsNullString(TheString) Then ' CDate liefert Fehler bei Nullstring
Str2Date = vbNullDate
Else
Str2Date = CDate(TheString)
End If
End Function
Public Function Variant2Date(ByVal TheString As Variant) As Date
If IsNullString(Nz(TheString)) Then
Variant2Date = vbNullDate
Else
Variant2Date = CDate(TheString)
End If
End Function