XL 2019 Conversion des dates

KHEROUBI

XLDnaute Junior
Bonjour
Je cherche à convertir une date en lettre dans word.
merci
 

Pièces jointes

  • Conversion de dates.docx
    12.3 KB · Affichages: 6

patricktoulon

XLDnaute Barbatruc
bonsoir
je l'ai pourtant donné plusieurs fois ;)
je suppose que ça doit être transposable dans vba word c'est du vba basique
en formule
version longue
=date_toutes_lettre(A1,1,0)

version courte
=date_toutes_lettre(A1)

utilisation en vba
VB:
Sub test2()
MsgBox date_toutes_lettre("22/05/2021")
MsgBox date_toutes_lettre("22/05/2021", True, False)
End Sub

la fonction
VB:
Function date_toutes_lettre(D As String, Optional dayletters As Boolean = False, Optional recomm1990 As Boolean = False)
'patricktoulon
'version 2018
  Dim x$, j$, unit, unitdix, mm$, CC$, Mil$, Cen$, Diz$, Dix$, U$, N$, Et$, S$, Dl$
    If IsNumeric(Left(D, 4)) Then D = Right(D, 2) & "/" & Mid(D, 6, 2) & "/" & Left(D, 4)
    If Not IsDate(D) Then date_toutes_lettre = "non valide": Exit Function
    x = IIf(IsNumeric(Right(D, 4)), Format(Right(D, 4), "0000"), Right("0000" & Year(D), 4))

    j = Day(D)
    unit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
    unitdix = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
    mm = " mille": CC = " cent ": Et = ""
    ' traitement du  jour
    If Day(D) < 20 Then j = unit(Day(D)) Else j = unitdix(Left(Day(D), 1)) & IIf(Right(Day(D), 1) = 1, " et ", IIf(Day(D) Mod 10 = 0, "", "-")) & unit(Right(Day(D), 1))
    If Day(D) = 1 Then j = "premier":

    'base de controle  des segementsde l'année
    Mil = Val(Left(x, 1)): Cen = Val(Mid(x, 2, 1)): Diz = Val(Mid(x, 3, 1)): U = Val(Right(x, 1)): Dix = Val(Mid(x, 3, 2))


    If Mil = 0 Then mm = ""    'si moins que mille mm=""
    If Mil = 1 Then Mil = 0    'pour eviter d'avoir "mille mille"

    If Cen = 0 Then CC = " "    'si moins que cent cc=""
    If Cen = 1 Then Cen = 0    'pour eviter d'avoir "cent cent"

    If Dix < 20 Then Diz = 0: U = Val(Mid(x, 3, 2))    'si la tranche des dizaine est moins que 200 diz=0et u =la tranche dizaine (de 11 à 19)

    If Dix Mod 10 <> 0 Then Et = "-"    ' un tiret sit pas de dizaine ronde

    If Dix > 20 And Dix < 80 And Val(Right(U, 1)) = 1 Then Et = " et "    'pour 21,31,41 etc... jusqu'a 71
    If Dix > 70 And Dix < 80 Or Dix > 90 Then Diz = Diz - 1: U = U + 10
    If Val(Right(x, 3)) < 10 Then Et = ""
    If Dix < 20 Then Et = ""

    N = Trim(unit(Mil) & mm & " " & unit(Cen) & CC & unitdix(Diz) & Et & unit(U) & S)
    If N = "mille" Or N = "cent" Or N = "un" Then N = "*" & N
    If Right(x, 2) = "80" Or Right(x, 2) = "20" And Val(Right(x, 3)) > 200 Then N = N & "s"

    If recomm1990 Then N = Replace(Application.Trim(N), " ", "-")
    N = Replace(N, "*", "de l'an ")
    Dl = IIf(dayletters, Format(D, "dddd "), "")    ' le jour en lettre ou pas

    date_toutes_lettre = Dl & j & " " & Format(D, "mmmm ") & N
End Function
 

Discussions similaires