conversion d'une somme en lettre et chiffre

Version imprimable

15/07/2016, 14h21
atlaslion

1 pièce(s) jointe(s)

conversion d'une somme en lettre et chiffre

salut tout le monde
je suis coincé. je cherche un code VBA ou une formule excel pour convertir une somme à la fois en lettre et chiffre.
voici un exemple : la somme de 204 DIRHAMS 18 CENTIMES
Je voudrais que cette somme soit convertie de cette façon :
deux cents quatre dirhams et 18 centimes.
merci pour votre aide.
15/07/2016, 14h37
Jean-Philippe André

Salut,

on a traite le sujet des transformations des nombre de chiffres en lettres ici :

http://access.developpez.com/sources...ffresEnLettres

un peu d'huile de cerveau et ca devrait pouvoir s'adapter facilement a ton cas de figure :)

Bonsoir on a trazité ce sujet il y a pas longtemps encore

l'exercice était de réduire les usines a gaz connues afin d'avoir un code compact et solide

ma version traite l'euro mais il sera facile d'adapter cela au dirham
et elle est utilisable en tant que fonction dans les cellules

fonction:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Function nombre_en_lettre5(nombre As String, Optional sstr As String = " euro", Optional sstr2 As String = " centime")
    Dim i As Long, unit1, unit10, tablo, e_dec(2), e As Long, u As Long, d As Long, c As Long, ct As String, cs As String, etE As String, a As String
    Dim decs As Long, ddd As String, ms, cms As Long, h As Long, ds As Long, et As String
    nombre = Replace(nombre, ".", ","): e_dec(0) = Split(nombre, ",")(0): e_dec(0) = Split(Trim(Format(e_dec(0), Application.Rept(" @@@", 20))), " ")
    If InStr(nombre, ",") > 0 Then e_dec(1) = Left(Split(nombre, ",")(1), 2): e_dec(1) = Split(Trim(Format(e_dec(1), Application.Rept(" @@@", 20))), " "): decs = 1
     etE = IIf(decs > 0, " et", ""): ddd = IIf(Val(Join(e_dec(0))) > 999000 And Right(Join(e_dec(0)), 6) = 0, IIf(sstr = " dollar", " de", " d'"), "")
    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", " zero")
    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)
    For e = 0 To decs
        tablo = e_dec(e): h = UBound(tablo)
        For i = 0 To h
            If e = 1 And i = h Then tablo(i) = "000" & Left(tablo(i), 2)
            a = ms(cms - (h - i)): a = IIf(tablo(i) = 0 And i < h, "", a): a = IIf(tablo(i) > 1 And i < h - 1 And a <> " mille", a & "s", a)
            tablo(i) = IIf(e = 0, Right("000" & tablo(i), 3), Mid(tablo(i) & "0", 3, 3))
            d = (tablo(i) Mod 100)
            c = Mid(tablo(i), 1, 1): c = IIf(c = 1, 20, c): ct = IIf(c < 9 And c > 1, " cent", ""): ct = IIf(tablo(i) Mod 100 = 0 And c <> 20 And c > 1, ct & "s", ct)
            cs = IIf(e > 0 And tablo(0) > 1, "s", ""): ds = Mid(Right(tablo(i), 2), 1, 1): u = Right(tablo(i), 1)
            u = IIf(Val(tablo(i)) = 1 And a = " mille", 0, u): u = IIf(tablo(i) = 0 And i = 0, 21, u)
            If d > 10 And d < 20 Or d > 70 And d < 80 Or d > 90 Then u = Val(Right(d, 1)) + 10: ds = Left(d, 1) - 1    'on calcul ds et u par le resultat du mod 100
            et = IIf(ds > 1 And ds < 9, IIf(Right(u, 1) = 1, IIf(ds = 8, "-", " et"), IIf(d Mod 10 = 0 And ds = 8, IIf(a = " mille", "", "s"), IIf(u = 0, "", "-"))), "")
            et = IIf(ds > 1 And ds < 7 And d Mod 10 = 0 And et = "-", "", et)
            If Join(e_dec(0)) = 0 And e = 0 Then sstr = "": etE = "": u = 0
            nombre_en_lettre5 = nombre_en_lettre5 & unit1((c)) & ct & unit10(ds) & et & unit1(u) & a
        Next
        nombre_en_lettre5 = Replace(nombre_en_lettre5 & IIf(e = 0, ddd & sstr & IIf(Int(nombre) > 1, "s", "") & etE, sstr2 & cs), "- ", "-")
    Next
End Function

exemple
formule a mettre dans une cellule pour tester

Citation:

=nombre_en_lettre5("12365.68")

a la place du nombre tu peut mettre une cellule avec une condition si elle est pleine

exemple

Citation:

=SI(A13=0;" ";nombre_en_lettre5(A13))

re
Bonjour grizan

sinon il y a ma petite dernière qui arrondi a 2 chiffres après la virgule en arrondissant au supérieur avec ma méthode dite globale dans une fonction récursive

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Function nBlettre_methode_globale(nombres As String)
    Dim en_dec(2)
    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)
    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
    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
        nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, " virgule", "")
    Next e
End Function
Sub tes2()
    MsgBox nBlettre_methode_globale(256354.2153)
End Sub

elle est beaucoup moins compliqué en terme de lisibilité de code

16/07/2016, 14h21
atlaslion

salut tout le monde
je me debats toujours
je n'arrive pas à m'en sortir car je suis novice en VBA
pouvez vous modifier ma piece jointe
merci pour votre aide
16/07/2016, 15h31
casefayere

1 pièce(s) jointe(s)

eh bien, tu l'as ou j'ai la berlue

Pièce jointe 215574
16/07/2016, 17h35
atlaslion

salut casefayere
la formule en question affiche la somme en lettre
par contre moi je voudrais qu'elle affiche une partie de la somme en lettre et l'autre partie en chiffre
comme suit
deux cent quatre dirhams et 18 centimes
16/07/2016, 18h03
papouclo

Bonjour,
Ecrire en C26 la formule :

Code:

=chiffrelettre(ENT($I$23))&" et "&ENT(100*MOD($I$23;1))&" centimes"

Cordialement
Claude
16/07/2016, 22h05
atlaslion

merci à papouclo
16/07/2016, 22h27
grisan29

bonsoir PatrickToulon :P

très bien ta fonction :P mais si je mets

Code:

nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, " et ", "centimes")

pour avoir et "et" a la place de "virgule" et c'est très bien
la seule chose est que si je veux un espace entre "et" et "centimes" je ne peux pas l'écrire comme ceci sans bug avec un nombre d'arguments incorrect

Code:

nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, " et ", " ", "centimes")

j'ai essayer le code du post3 et celui la est parfait :lol: mais le calcul n'est pas correct si le nombre a plus de 2 chiffres après virgule l'arrondi n'est compté
Pièce jointe 215593

Pascal
17/07/2016, 00h25
patricktoulon

re
allons grizan un peu de reflection

le iif sert a mettre "virgule"ou rien selon "e" qui represente l'etape des entier pour 0 et 1 pour les décimales tu ne peut donc pas mettre "centimes" dans les guillemts vides
puisqu'il faut tout faire voila fin de la fonction comme tu le souhaite ca m'a pris 15 secondes !!!!
Code:

1 2 3 nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, " euros et ", "") & IIf(e = 1, " centimes", "") Next e End Function
la condition rouge sert a mettre virgule ,euros ou tout ce que tu veux si decs=1 et e est encore a zéro
la condition verte que je viens d'ajouter sert a jouter les centimes si e=1 ca veut dire que la boucle a tourner 2 fois la 2 eme pour les chiffres après la virgule

on pourrais ajouter aussi l'accords comme dans l'autre
le "de ou "d'" d'euros ou de dirham etc....
exemple
un million d'euros et 23 centimes
un million de dirham et 23 centimes

pas compliqué non de dieu
j'ai passer plus de 7 jours a les mettre au points ces fonctions afin que l'orthographe (accent ,trait d'union , les pluriels ,etc....) satis face le plus grand nombre et toi tu me colle cette
question:salo: :ptdr:
change la ligne originale pour celle qui est en couleur et tout ira bien

edit tien regarde cette version de la ligne j'accorde le s a euros si pas de décimales sinon coup de bluff "euro" sans le "s" sert a euro cent

Code:

nBlettre_methode_globale = nBlettre_methode_globale & IIf(e = 0 And decs = 1, " euros et ", " euro") & IIf(e = 0 And decs = 0, "s", "") & IIf(e = 1, "cent", "")

voila voila

test
Code:

1 2 3 4 5 Sub tes2() MsgBox nBlettre_methode_globale(524153256354.2153) MsgBox nBlettre_methode_globale(698745236256354) end sub
17/07/2016, 16h15
grisan29

bonjour PatrickToulon
Merci de tes réponses qui correspondent bien:lol:

je vais laisser le post a atlaslion tranquille, car depuis bientôt 3 ans, je vois que l'offre que m'avais fait gentiment BlueMonkey :lol: n'est pas encore digérée, et pourtant depuis de l'eau a couler

Pascal