Ecrire une date en texte (US)

En fouinant sur Internet, j’ai trouvé récemment une macro pour transformer une date en texte. Il m’a fallu la modifier un peu pour qu’elle fonctionne sur un Excel en français. Voici le résultat, où nous avons un certain nombre de dates et leur traduction en texte (US) :

Voici le code de la macro :

Function DateToWords_US(ByVal DateIn As Variant) As String

' Auteur : Rick Rothstein ?

' Correction du mois : Hervé Thiriez

Dim Mois 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", "Ninth", _

"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-ninth", "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_US = "Twenty-nineth of February, One Thousand Nine 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

Mois = Format$(DateIn, "mmmm")

Select Case Mois

Case "janvier": Mois = "January"

Case "février": Mois = "February"

Case "mars": Mois = "March"

Case "avril": Mois = "April"

Case "mai": Mois = "May"

Case "juin": Mois = "June"

Case "juillet": Mois = "July"

Case "août": Mois = "August"

Case "septembre": Mois = "September"

Case "octobre": Mois = "October"

Case "novembre": Mois = "November"

Case "décembre": Mois = "December"

End Select

DateToWords_US = Ordinal(Day(DateIn) - 1) & " of " & Mois & ", " & _

Cardinal(CInt(Left$(Yrs, 1))) & " Thousand " & Hundreds & Decades

End Function

Un petit exercice pour vous distraire : essayez de modifier cette macro pour qu’elle donne le texte de la date en français…

Remarque – Attention ! Le français est une langue plus complexe et il y aura des pièges à contourner…