Code:
Function DateToWords(ByVal DateIn As Variant) As String
Dim Yrs As String, Hundreds As String, Decades As String
Dim Tens As Variant, Ordinal As Variant, Cardinal As Variant
Ordinal = Array("First", "Second", "Third", "Fourth", "Fifth", "Sixth", "Seventh", "Eighth", "Nineth", _
"Tenth", "Eleventh", "Twelfth", "Thirteenth", "Fourteenth", "Fifteenth", "Sixteenth", _
"Seventeenth", "Eighteenth", "Nineteenth", "Twentieth", "Twenty-first", "Twenty-second", _
"Twenty-third", "Twenty-fourth", "Twenty-fifth", "Twenty-sixth", "Twenty-seventh", _
"Twenty-eighth", "Twenty-nineth", "Thirtieth", "Thirty-first")
Cardinal = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", _
"Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
Tens = Array("Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
DateIn = CDate(DateIn)
Yrs = CStr(Year(DateIn))
Decades = Mid$(Yrs, 3)
If CInt(Decades) < 20 Then
Decades = Cardinal(CInt(Decades))
Else
Decades = Tens(CInt(Left$(Decades, 1)) - 2) & "-" & Cardinal(CInt(Right$(Decades, 1)))
End If
Hundreds = Mid$(Yrs, 2, 1)
If CInt(Hundreds) Then
Hundreds = Cardinal(CInt(Hundreds)) & " Hundred "
Else
Hundreds = ""
End If
DateToWords = Ordinal(Day(DateIn) - 1) & " of " & Format$(DateIn, "mmmm") & ", " & _
Cardinal(CInt(Left$(Yrs, 1))) & " Thousand " & Hundreds & Decades
End Function
Bookmarks