XL 2019 Convertir des chiffres en lettres

ajox01

XLDnaute Junior
Bonjour Chers experts,

J'ai besoin de votre aide. Je voudrais une fonction qui me permettra de convertir automatiquement les chiffres monétaires en lettres dans excel.

Exemple: 3 742,50 euros donnera Trois mille sept cent quarante deux Euros Cinquante centimes.

Merci d'avance de votre support

Cordialement
Ajox01
 

patricktoulon

XLDnaute Barbatruc
bonjour
colle ca dans un module
VB:
Option Explicit
Function NblettreFR(chain As String) As String
    Dim t, dixx&, dix&, cxx&, u&, Part, ms, m, Ul, Diz, n&, I&, seg$, cc$, et$, Ss$, R$, md$, euro$, centime
    Ul = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "cent ")
    Diz = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix", "cent")
    ms = Array("", " decilliard", " decillion", " nonilliard", " nonillion", " octillard", " octillion", " septilliard", " septillion", " sextilliard", " sextillion", " quintilliard ", " Quintillion", " quadrilliard", " quadrillion", " trilliard", " trillion", " Billiard", " billion", " milliard", " million", " mille", "")
    If LCase(chain) Like "*[a-z|:|;|/|\]*" Then NblettreFR = "Invalid Chaine!!": Exit Function
    Part = Split(chain, ","): If Len(Part(0)) > 66 Then NblettreFR = "OutOFF(CAR*66)!!": Exit Function
    euro = IIf(Val(Part(0)) > 999000 And Val(Right(Part(0), 6)) = 0, "d'euro", "euro") & IIf(Part(0) > 1, "s ", " ") & IIf(UBound(Part) > 0, "et ", "")
    centime = IIf(UBound(Part) > 0, "Centime", ""): If UBound(Part) > 0 Then If Part(1) = 0 Then Part = Array(Part(0)): centime = "": euro = Replace(euro, "et", "")
    For n = LBound(Part) To UBound(Part)
        t = Split(Trim(Format(String((300 - Len(Part(n))) Mod 3, "0") & Part(n), WorksheetFunction.Rept(" @@@", Len(String((300 - Len(Part(n))) Mod 3, "0") & Part(n)) / 3))))
        If n = 1 Then If Len(Part(1)) = 1 Then t = Array("0" & Part(1) & "0")    'ajustement centime(0.5 = 0.50)
        m = UBound(ms) - UBound(t)
        For I = LBound(t) To UBound(t)
            cxx = Left(t(I), 1): dixx = Right(t(I), 2): dix = Mid(t(I), 2, 1): u = Right(t(I), 1)
            If cxx = 1 Then cxx = 20: cc = "" Else cc = IIf(cxx > 0, " cent ", "")
            If dix = 9 Or dix = 7 Then dix = dix - 1: u = Val(u) + 10
            If dixx > 9 And dixx < 20 Then dix = 0: u = u + 10
            If dix >= 2 And dix <= 7 And (u = 1 Or u = 11) Then et = " et " Else et = IIf(dix <> 0 And u <> 0, "-", " ")
            If dixx = 80 Then Ss = "s" Else Ss = ""
            If I = UBound(t) - 1 And Part(0) = 1000 Then u = 0
            md = ms(m): If Val(t(I)) > 1 And I < UBound(t) - 1 Then md = md & "s"
            R = R & Application.Trim(Ul(cxx) & cc & Diz(dix) & et & Ul(u)) & Ss & IIf(Val(t(I)) > 0, md, "") & " "
            m = m + 1
        Next
        If Val(Part(0)) = 0 Then euro = ""
        R = R & IIf(n = 0, euro, centime): If n = 1 Then If Part(1) > 1 Then R = R & "s" & IIf(Part(0) = 0, " d'euro", "")
        If Trim(R) = "" Then R = ""
    Next n
    NblettreFR = Trim(R)
End Function

et dans une cellule
exemple

=si(A1>0;NblettreFR(A1);"")
terminé ;)
demo4.gif
 

jmfmarques

XLDnaute Accro
Bonjour à tous
Juste pour appeler votre attention sur quelques points, qui nécessitent un paramétrage complet de l'outil de conversion :
Les principaux (et non uniques) paramètres :
- nom de l'unité des entiers de la monnaie - au pluriel et au singulier (peuvent différer de manière significative)
- nom de l'unité des subdivisions (idem que pour les entiers)
- genre (masculin ou féminin) des entiers de la monnaie (on dit cent une roupies et non cent un roupies)
- genre (masculin ou féminin) des subdivisions de la monnaie
 

ajox01

XLDnaute Junior
Bonjour à tous
Juste pour appeler votre attention sur quelques points, qui nécessitent un paramétrage complet de l'outil de conversion :
Les principaux (et non uniques) paramètres :
- nom de l'unité des entiers de la monnaie - au pluriel et au singulier (peuvent différer de manière significative)
- nom de l'unité des subdivisions (idem que pour les entiers)
- genre (masculin ou féminin) des entiers de la monnaie (on dit cent une roupies et non cent un roupies)
- genre (masculin ou féminin) des subdivisions de la monnaie
Bonjour,

Je ne comprends vraiment rien car je suis nouveau dans les macros... Merci de m'envoyer le paramétrage complet svp...

Cordialement
Achirou
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, et ses intervenants

Bonjour,
Je ne comprends vraiment rien car je suis nouveau dans les macros...
Si j'étais moi, j'utiliserai plutôt Word qui fait cela tout seul et sans macros ;)
grâce à CARDTEXT
Un petit exemple ci-dessous
Dans Word, faire CTRL+F9
On obtient alors {.}
Saisir alors le nombre à convertir comme ci-dessous
(ici j'ai pris 1111 comme nombre)
{=1111 \*CARDTEXT \*Upper}
Puis faire clic-droit et Mettre à jour les champs
On obtiendra alors : MILLE CENT ONZE

Voila simple, sans macro

PS: Si besoin dans Excel, il suffira de faire CTRL+C puis CTRL+V
 

ajox01

XLDnaute Junior
Bonjour le fil, et ses intervenants


Si j'étais moi, j'utiliserai plutôt Word qui fait cela tout seul et sans macros ;)
grâce à CARDTEXT
Un petit exemple ci-dessous
Dans Word, faire CTRL+F9
On obtient alors {.}
Saisir alors le nombre à convertir comme ci-dessous
(ici j'ai pris 1111 comme nombre)
{=1111 \*CARDTEXT \*Upper}
Puis faire clic-droit et Mettre à jour les champs
On obtiendra alors : MILLE CENT ONZE

Voila simple, sans macro

PS: Si besoin dans Excel, il suffira de faire CTRL+C puis CTRL+V
Merci pour ton support.... mais je cherchais une solution pour Excel....
Cordialement
Ajox01
 

Discussions similaires

Réponses
116
Affichages
3 K

Statistiques des forums

Discussions
312 023
Messages
2 084 715
Membres
102 637
dernier inscrit
TOTO33000