PDA

View Full Version : Modifying DateToWords function



vishwajeet_chakravorty
04-01-2012, 01:48 AM
If I want to change the Date 21/05/1962 in word Twenty first May nineteen hundred sixsty two. (Not one thousand nine hundred sixty two) and 21/05/2011 to Two thousand twelve then then how to modify this VBA 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")
If TypeOf Application.Caller Is Range Then
' The date serial number that Excel's worksheet thinks is for 2/29/1900
' is actually the date serial number that VB thinks is for 2/28/1900
If Format([DateIn], "m/d/yyyy") = "2/28/1900" Then
DateToWords = "Twenty-nineth of February, Nineteen Hundred"
Exit Function
ElseIf DateIn < DateSerial(1900, 3, 1) Then
If TypeOf Application.Caller Is Range Then DateIn = DateIn + 1
End If
End If
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)))
If Right(Decades, 1) = "-" Then Decades = Left(Decades, Len(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