XL 2019 Convertir des chiffres en lettres

  • Initiateur de la discussion Initiateur de la discussion ajox01
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
Bonsoir Ajox, Staple,
Deux exemples :
 
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
 
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 à 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
 
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
116
Affichages
6 K
Retour