XL 2019 Convertir des chiffres en lettres

[ajox01]

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]

donne moi la syntaxe de création peut être que c'est moi qui fait une poussée de fièvre coronavirusienne

 

[Staple1600]

Re

La syntaxe de création de quoi?

 

[patricktoulon]

re
ben de l'object avec le guid (clisd)

 

[Staple1600]

Re

Je n'ai fais que tester l'ajout de la référence Word par code VBA.
C'est ce test qui OK sur mon Excel 2013.

 

[patricktoulon]

Bonjour Staple1600
bon ca l'installe bien mais elle ne fonctionne que la fois suivante

 

[King Luymas]

bonjour
colle ca dans un module

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é
Regarde la pièce jointe 1059344
Bonsoir, et merci pour le code, mais je voudrais savoir comment faire dans ce code afin que le montant s’arrête à deux décimales?
car j'ai copie ce code et voila les résultats que cela donne:

 

[patricktoulon]

Bonsoir

nombre en toutes lettre FR diverse monnaies et autres

cette fonction converti n'importe quel nombres en toutes lettres avec la monnaie "Euro" en francais voir la discussion et surtout les mises a jour ICI Function NblettreFR(chain As String) As String Dim t, dixx&, dix&, cxx&, u&, Part, ms, m...

www.excel-downloads.com

 

[Jouxte]

Bonjour à toutes et tous,

Merci pour ce très beau travail qui respecte les règles grammaticales pour le tiret.
J'ai trois petites remarques :
=>100 s'accorde s'il est multiplié et lorsqu'il n'y a pas de chiffre après. Dans le cas contraire, il est invariable. Par exemple : deux cents euros et deux cent un euros

200	deux cent euros
201	deux cent un euros

=> Il y a un petit bug sur les milliers

1276,036

un mille deux cent soixante-seize euros et trente-six Centimes

=> si le résultat d'un calcul amène à plusieurs chiffres après la virgule et que les premiers sont des zéros, la macro ne les considère pas.

126,0036

cent vingt-six euros et trente-six Centimes

J'ai vu la macro sans les devises, mais elle ne respecte pas la règle du tiret. mais je n'ai peut-être pas trouvé la dernière version.
Merci encore.
Bonne soirée.

 

[patricktoulon]

bonsoir jouxte
c'est voulu
en monnaie pas plus de 2 chiffre après la virgule
1 euro =100 centimes après 99 on revient a zero et augmente de 1 l'entier, il ne peut donc pas y avoir 3 caractères numériques après la virgule

quand tu lis les étiquettes de prix dans les magasin tu lis 126,36€ et non 126,036€

 

[patricktoulon]

si tu veux la version qui te donne l'arrondi de 036 c'est ma méthode globale qu'il te faut
126.036 donnera

la formule
=SI(A6=0;" ";nBlettre_methode_globale((A6);"euro";1))

en vba
Sub testx()
MsgBox nBlettre_methode_globale(126.036, "euro", True)
End Sub

la fonction

Option Explicit
 
Function nBlettre_methode_globale(nombres As String, Optional ByVal sstr As String = "virgule", Optional ByVal finance As Boolean = False)
    Dim en_dec(2), unit1, unit10, ms, cms As Long, decs As Long, ex As Long, ddd As String, centi As String, e As Long, i As Long, a As Long, dix As Long
    Dim nombre As String, u As String, c As String, ct As String, et As String, ss As String, neg As Boolean
    unit1 = Array("", " Un", " Deux", " Trois", " Quatre", " Cinq", " Six", " Sept", " Huit", " Neuf", " Dix", " Onze", " Douze", " treize", " Quatorze", " Quinze", " Seize", " Dix-Sept", " Dix-Huit", " Dix-Neuf", " cent", " zéro")
    unit10 = Array("", " dix", " vingt", " trente", " quarante", " cinquante", " soixante", " soixante-dix", " quatre-vingt", " quatre-vingt-dix", " cent")
    ms = Array("", " sextillion", " Quintillion", " Quatrillion", " Trillion", " Billiard", " Billion", " milliard", " million", " mille", ""): cms = UBound(ms)
 
    If Left(nombres, 1) = "-" Then nombres = Mid(nombres, 2, Len(nombres)): neg = True
    decs = 0: nombres = Replace(nombres, ".", ","): en_dec(0) = Split(nombres, ",")(0): If InStr(nombres, ",") > 0 Then en_dec(1) = Split(nombres, ",")(1): decs = 1    'on separe le decimal de l'entier
    If Len(en_dec(0)) Mod 3 <> 0 Then en_dec(0) = Application.Rept("0", 3 - Len(en_dec(0)) Mod 3) & en_dec(0)    'on formate l'entier a 3 chiffre par tranche
    If decs = 1 Then en_dec(1) = Right("00" & Round(Val("0." & en_dec(1)), 2) * 100, 3)  ' NOUVELLE METHODE POUR ADAPTER LE DECIMAL on formate a 3 chiffres
    ex = cms - (Len(en_dec(0)) / 3) + 1    ' index de point de depart des expressions dans l'array ms
    ddd = IIf(Val(en_dec(0)) > 999000 And Val(Right(en_dec(0), 6)) = 0, IIf("aAeEiIoOuUyY" Like "*" & Left(sstr, 1) & "*", " d' ", " de"), " ")
    centi = IIf(sstr <> "dollar", " centime", " cent")
    If sstr = "virgule" Then centi = ""
    sstr = IIf(Val(en_dec(0)) > 1, sstr & "s", sstr)
    If decs = 1 Then centi = IIf(Val(en_dec(1)) > 1, centi & "s", centi)
    For e = 0 To decs
        For i = 1 To Len(en_dec(e)) Step 3
            a = ex + Round(i / 3)    'position actuelle de ms
            nombre = Mid(en_dec(e), i, 3)    ' la tranche
            dix = Mid(nombre, 2, 1): u = Right(nombre, 1): c = Left(nombre, 1): If c > 1 Then c = c: ct = unit1(20) & IIf(Val(dix & u) > 0, "", "s") Else: ct = "": If c = 1 Then c = 20
            If dix = 1 Or dix = 7 Or dix = 9 And Right(u, 1) > 0 Then dix = dix - 1: u = u + 10   'on corrige le 1,7,9
            If dix > 1 And dix <> 8 And Right(u, 1) = 1 Then et = " et" Else: If dix = 0 Or u = 0 Then et = "" Else et = "-"  ' on accorde de 1 a 99
 
            If u = 0 Then If dix = 8 Then If ms(a) = " mille" Then et = "" Else et = "s"     'le s a quatre-vingt tout seul
 
            If nombre = 0 And Len(en_dec(0)) = 3 Then u = 21: dix = 0    ' le zéro si l'entier vaut 0 tout simplement
            If nombre = 0 And i <> 1 Then a = 0
            If nombre = 1 And i = 1 And a = cms - 1 Then u = 0
            If e = 0 And nombre > 1 And a < cms - 1 Then ss = "s" Else ss = ""
            nBlettre_methode_globale = nBlettre_methode_globale & Replace(unit1(c) & ct & unit10(dix) & et & unit1(u), "- ", "-") & IIf(e = 0, ms(a), "") & ss
        Next i
        If finance = False Then
            nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, " virgule ", "")
        Else
            nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, ddd & " " & sstr & " et ", IIf(decs = 0, " " & sstr, "")) & IIf(e = 1, centi, "")
        End If
    Next e
    If neg = True Then nBlettre_methode_globale = "moins " & nBlettre_methode_globale
End Function

Sub testx()
MsgBox nBlettre_methode_globale(126.036, "euro", True)
End Sub

a+

 

[sebbbbb]

BONSOIR

Function SpellNumberToEnglish(ByVal pNumber)
'Updateby20131113
Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
xHundred = ""
xValue = Right(pNumber, 3)
If Val(xValue) <> 0 Then
xValue = Right("000" & xValue, 3)
If Mid(xValue, 1, 1) <> "0" Then
xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
End If
If Mid(xValue, 2, 1) <> "0" Then
xHundred = xHundred & GetTens(Mid(xValue, 2))
Else
xHundred = xHundred & GetDigit(Mid(xValue, 3))
End If
End If
If xHundred <> "" Then
Dollars = xHundred & arr(xIndex) & Dollars
End If
If Len(pNumber) > 3 Then
pNumber = Left(pNumber, Len(pNumber) - 3)
Else
pNumber = ""
End If
xIndex = xIndex + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollar"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cent"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumberToEnglish = Dollars & Cents
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
Select Case Val(pTens)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else
Select Case Val(Left(pTens, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit(Right(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function

 

[patricktoulon]

bonjour sebbbbb
je la connais cette fonction elle est vieille et il y en a quelque une
oui l'anglais est beaucoup plus facile il n'y a pas les subtilités de l'orthographe français
par exemple en français
70 s’écrit soixante-dix 60 10
71 s’écrit soixante et onze 60 et 11
72 soixante douze 60 12
en anglais
70 seventy
71 seventy one 70 1
72 seventy two 70 2

 

[patricktoulon]

re
tiens par exemple ce moteur pourrait suffire a convertir un nombre par tranche de trois chiffres

Sub test()
    Dim x&, d$, u$, unit, diz
     unit = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    diz = Array("", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
 
    
    c = 148 '!!!!!!testez un nombre a trois chiffre ici !!!!!
    
    
    c = Val("000" & c)
     cent = ""
    u = ""
    d = ""
    If c > 99 Then
        cent = Left(CStr(c), 1)
        If Val(cent) > 1 Then cent = unit(Val(cent)) & " hundred " Else cent = " hundred "
        c = Val(c Mod 100)
    End If
    If c < 19 And c > 0 Then
        d = "": u = unit(Val(c))
    Else
        x = c - (c Mod 10)
        d = diz(x / 10)
        u = unit(c - x)
    End If
    chaine = cent & d & u
    chaine = IIf(chaine = "", "zero", chaine)


    MsgBox Trim(chaine)
End Sub

voila comme tu peut le voir pour la conversion anglo-saxonne il faut pas grand chose

 

[VIARD]

Bonjour Jouxte, Patrick, Sebbbbb et à toutes et tous

Pour ma part j'utilise un code d'ExcelLabo que j'ai modifié pour la devise.

'===================================
Function chiffrelettre(s, dvise) 'Trouvé sur ExceLabo
'Modifié (s => la somme en chiffre), (dvise => la devise du pays)JPV
' étant fait par excelabo, ça m'évite de devoir cogiter pour le faire
Dim A As Variant, gros As Variant
Dim Sp As Variant, Chaine$
Dim centime As Double
'Dim Lg%, Gp%, K%, X As Long, c As Long, D As Long
Dim Devise$
'---------------------------------
Devise = dvise '"Euro"
Select Case dvise
    Case "€": Devise = "Euro"
    Case "$": Devise = "USD"
    Case "£": Devise = "GBP"
End Select
'---------------------------------
A = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", Devise, "billion", _
"milliard", "million", "mille", Devise)

Sp = Space(1)
Chaine = "00000000000000"
'-------- Nouvelle Calédonie pas de Centime --------
If Devise = "CFP" Then
    centime = 0
    s = Format(s, "## ###,##0 [$" & "CFP" & "-1]")
Else
    centime = s * 100 - (Int(s) * 100)
End If
'---------------------------------------------------
s = Str(Int(s)): Lg = Len(s) - 1: s = Right(s, Lg): Lg = Len(s)
If Lg < 15 Then Chaine = Mid(Chaine, 1, (15 - Lg)) Else Chaine = ""
s = Chaine + s
'billions au centaines
Gp = 1
For K = 1 To 5
    X = Mid(s, Gp, 1): C = A(Val(X))
    X = Mid(s, Gp + 1, 2): D = A(Val(X))
    If K = 5 Then
        If T2 <> "" And C & D = "" Then mydz = Devise & Sp: GoTo Fin
        If T <> "" And C = "" And D = "un" Then mydz = "un " & Devise & Sp: GoTo Fin
        If T <> "" And T2 = "" And C & D = "" Then mydz = "d'" & Devise & Sp: GoTo Fin
        If T & C & D = "" Then myct = "": mydz = "": GoTo Fin
    End If
    If C & D = "" Then GoTo Fin
    If D = "" And C <> "" And C <> "un" Then mydz = C & Sp & "cents " & gros(K) & Sp: GoTo Fin
    If D = "" And C = "un" Then mydz = "cent " & gros(K) & Sp: GoTo Fin
    If D = "un" And C = "" Then myct = IIf(K = 4, gros(K) & Sp, "un " & gros(K + 5) & Sp): GoTo Fin
    If D <> "" And C = "un" Then mydz = "cent" & Sp
    If D <> "" And C <> "" And C <> "un" Then mydz = C & Sp & "cent" + Sp
    myct = D & Sp & gros(K) & Sp
Fin:
    T2 = mydz & myct
    T = T & mydz & myct
    mydz = "": myct = ""
    Gp = Gp + 3
Next
D = A(centime)
If T <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If T = "" Then myct = IIf(centime = 1, " centime d'" & Devise, " centimes d'" & Devise)
If centime = 0 Then D = "": myct = ""
chiffrelettre = T & D & myct
End Function
'============================================

Bien amicalement
Jean-Paul

 

[Jouxte]

Bonjour Patricktoulon
Cette méthode globale est superbe.
Merci pour cette superbe macro.

​