Convertir une Date en Lettres
ce que l'on tente d'obtenir
Ceci avec une fonction =ConvertDate2Lettres(A3)
Remarquez que les dates avant 1900 sont considérées comme du texte (alignement à gauche) mais que l'on peut malgré tout les traiter
Function ConvertDate2Lettres(Valeur As String)
Dim Jour As String, Mois As String, Annee As String
Dim Millier As String, Centaine As String, Dizaine As String, Unite As String
<span style="color: brown; font-size: small;"><b>'on sépare les parties de date</b></span>
Jour = Day(Valeur)
Mois = Month(Valeur)
Annee = Year(Valeur)
<span style="color: brown; font-size: small;"><b>'On traite les jours</b></span>
Select Case Jour
Case "1"
Jour = "Un"
Case "2"
Jour = "Deux"
Case "3"
Jour = "Trois"
Case "4"
Jour = "Quatre"
Case "5"
Jour = "Cinq"
Case "6"
Jour = "Six"
Case "7"
Jour = "Sept"
Case "8"
Jour = "Huit"
Case "9"
Jour = "Neuf"
Case "10"
Jour = "Dix"
Case "11"
Jour = "Onze"
Case "12"
Jour = "Douze"
Case "13"
Jour = "Treize"
Case "14"
Jour = "Quatorze"
Case "15"
Jour = "Quinze"
Case "16"
Jour = "Seize"
Case "17"
Jour = "Dix-Sept"
Case "18"
Jour = "Dix-Huit"
Case "19"
Jour = "Dix-Neuf"
Case "20"
Jour = "Vingt"
Case "21"
Jour = "Vingt-Un"
Case "22"
Jour = "Vingt-Deux"
Case "23"
Jour = "Vingt-Trois"
Case "24"
Jour = "Vingt-Quatre"
Case "25"
Jour = "Vingt-Cinq"
Case "26"
Jour = "Vingt-Six"
Case "27"
Jour = "Vingt-Sept"
Case "28"
Jour = "Vingt-Huit"
Case "29"
Jour = "Vingt-Neuf"
Case "30"
Jour = "Trente"
Case "31"
Jour = "Trente et Un"
End Select
<span style="color: brown; font-size: small;"><b>'on traite les mois</b></span>
Select Case Mois
Case "1"
Mois = "Janvier"
Case "2"
Mois = "Février"
Case "3"
Mois = "Mars"
Case "4"
Mois = "Avril"
Case "5"
Mois = "Mai"
Case "6"
Mois = "Juin"
Case "7"
Mois = "Juillet"
Case "8"
Mois = "Août"
Case "9"
Mois = "Septembre"
Case "10"
Mois = "Octobre"
Case "11"
Mois = "Novembre"
Case "12"
Mois = "Décembre"
End Select
'Pour les années c'est un peu plus complexe
'on teste si on a un 1 ou un 2 en première position
'et si la longueur est de 4 caractères
If Left(Annee, 1) = "1" And Len(Annee) > 3 And Len(Annee) < 5 Then
Millier = "Mille"
ElseIf Left(Annee, 1) = "2" And Len(Annee) > 3 And Len(Annee) < 5 Then
Millier = "Deux Mille"
End If
'idem pour la postionne des centaines
'il faut bien traiter le cas d'avant l'an 1000
If Len(Annee) = 4 Then
Centaine = Mid(Annee, 2, 1)
ElseIf Len(Annee) = 3 Then
Centaine = Left(Annee, 1)
End If
If Centaine <> "0" Then
Select Case Centaine
Case "1"
Centaine = "Cent"
Case "2"
Centaine = "Deux Cents"
Case "3"
Centaine = "Trois Cents"
Case "4"
Centaine = "Quatre Cents"
Case "5"
Centaine = "Cinq Cents"
Case "6"
Centaine = "Six Cents"
Case "7"
Centaine = "Sept Cents"
Case "8"
Centaine = "Huit Cents"
Case "9"
Centaine = "Neuf Cents"
End Select
End If
'idem pour la dizaine
'ici, il faut envisager l'avant l'an 100
'en plus des autres cas
If Len(Annee) = 4 Then
Dizaine = Mid(Annee, 3, 1)
ElseIf Len(Annee) = 3 Then
Dizaine = Mid(Annee, 2, 1)
ElseIf Len(Annee) = 2 Then
Dizaine = Left(Annee, 1)
End If
If Dizaine <> "0" Then
Select Case Dizaine
Case "1"
Dizaine = "Dix"
Case "2"
Dizaine = "Vingt"
Case "3"
Dizaine = "Trente"
Case "4"
Dizaine = "Quarante"
Case "5"
Dizaine = "Cinquante"
Case "6"
Dizaine = "Soixante"
Case "7"
Dizaine = "Septante"
Case "8"
Dizaine = "Quatre-Vingts"
Case "9"
Dizaine = "Nonante"
End Select
End If
'idem et l'avant l'an 10
If Len(Annee) = 4 Then
Unite = Mid(Annee, 4, 1)
ElseIf Len(Annee) = 3 Then
Unite = Mid(Annee, 3, 1)
ElseIf Len(Annee) = 2 Then
Unite = Mid(Annee, 2, 1)
Else
Unite = Left(Annee, 1)
End If
If Unite <> "0" Then
Select Case Unite
Case "1"
Unite = "Un"
Case "2"
Unite = "Deux"
Case "3"
Unite = "Trois"
Case "4"
Unite = "Quatre"
Case "5"
Unite = "Cinq"
Case "6"
Unite = "Six"
Case "7"
Unite = "Sept"
Case "8"
Unite = "Huit"
Case "9"
Unite = "Neuf"
End Select
End If
'Alors comme d'habitude les zéros fichent la pagaille
'donc, il faut tenter d'envisager tous les cas possible
'et on renvoit le résultat de la fonction
If Len(Annee) > 3 And Len(Annee) < 5 And Centaine <> "0" And Dizaine <> "0" And Unite <> "0" Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Millier & " " & Centaine & " " & Dizaine & " " & Unite
ElseIf Len(Annee) > 3 And Len(Annee) < 5 And Centaine <> "0" And Dizaine <> "0" And Unite = "0" Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Millier & " " & Centaine & " " & Dizaine
ElseIf Len(Annee) > 3 And Len(Annee) < 5 And Centaine <> "0" And Dizaine = "0" And Unite <> "0" Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Millier & " " & Centaine & " " & Unite
ElseIf Len(Annee) > 3 And Len(Annee) < 5 And Centaine = "0" And Dizaine <> "0" And Unite <> "0" Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Millier & " " & Dizaine & " " & Unite
ElseIf Len(Annee) > 3 And Len(Annee) < 5 And Centaine = "0" And Dizaine = "0" And Unite <> "0" Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Millier & " " & Unite
ElseIf Len(Annee) > 3 And Len(Annee) < 5 And Centaine = "0" And Dizaine = "0" And Unite = "0" Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Millier
ElseIf Len(Annee) > 2 And Len(Annee) < 4 Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Centaine & " " & Dizaine & " " & Unite
ElseIf Len(Annee) > 1 And Len(Annee) < 3 Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Dizaine & " " & Unite
ElseIf Len(Annee) > 0 And Len(Annee) < 2 Then
ConvertDate2Lettres = Jour & " " & Mois & " " & Unite
End If
End Function
Cliquez ici pour télécharger le fichier exemple ConvertDate2Texte