XL 2010 somme en toutes lettres

eastwick

XLDnaute Impliqué
Bonjour à toutes et tous, le lien vers cathy astuces est mort. Comment trouver une macro pour exprimer une somme en toutes lettres ? (uniquement en euros et en respectant l'apparition de S ou pas)
ex : 1,05 donne un euro et cinq centimes
23,01 donne vingt trois euros et un centime
Le "et" est important.

D'avance merci !!!
 

M12

XLDnaute Accro
Bonjour

A tester dans un module
Code:
Function chiffrelettre(s)

Dim a As Variant, gros As Variant
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", "Euros", "billion", _
"milliard", "million", "mille", "Euro")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
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 = "Euros" & sp: GoTo fin
If T <> "" And C = "" And d = "un" Then mydz = "un Euros" & sp: GoTo fin
If T <> "" And t2 = "" And C & d = "" Then mydz = "d'Euros" & 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'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
If T = "" Then
    chiffrelettre = T & d & myct
    Else
    If d = "" Then
chiffrelettre = T '& " et " & d & myct
Else
chiffrelettre = T & " et " & d & myct
End If
End If
End Function
 

Kantarus

XLDnaute Nouveau
Bonjour,
Sinon voici.

Attribute VB_Name = "ModNumLettre"
Option Explicit


'***********
' Devise=0 aucune
' =1 Euro €
' =2 Dollar $
' Langue=0 Français
' =1 Belgique
' =2 Suisse
'***********
' Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
' si le nombre contient plus de 2 décimales, il est arrondit à 2 décimales


Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 0, _
Optional Langue As Byte = 0) As String
Dim dblEnt As Variant, byDec As Byte
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String

If Nombre < 0 Then
bNegatif = True
Nombre = Abs(Nombre)
End If
dblEnt = Int(Nombre)
byDec = CInt((Nombre - dblEnt) * 100)
If byDec = 0 Then
If dblEnt > 999999999999999# Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
Else
If dblEnt > 9999999999999.99 Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
End If
Select Case Devise
Case 0
If byDec > 0 Then strDev = " virgule"
Case 1
strDev = " Euro"
If byDec > 0 Then strCentimes = strCentimes & " "
Case 2
strDev = " Dollar"
If byDec > 0 Then strCentimes = strCentimes & " Cents"
End Select
If dblEnt > 1 And Devise <> 0 Then strDev = strDev & ""
ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " " & _
ConvNumDizaine(byDec, Langue) & strCentimes
End Function

Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
Dim byNum As Byte, iTmp As Variant, dblReste As Double
Dim strTmp As String

iTmp = Nombre - (Int(Nombre / 1000) * 1000)
ConvNumEnt = ConvNumCent(CInt(iTmp), Langue)
dblReste = Int(Nombre / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
strTmp = ConvNumCent(CInt(iTmp), Langue)
Select Case iTmp
Case 0
Case 1
strTmp = "mille "
Case Else
strTmp = strTmp & " mille "
End Select
ConvNumEnt = strTmp & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
strTmp = ConvNumCent(CInt(iTmp), Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " million "
Case Else
strTmp = strTmp & " millions "
End Select
ConvNumEnt = strTmp & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
strTmp = ConvNumCent(CInt(iTmp), Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " milliard "
Case Else
strTmp = strTmp & " milliards "
End Select
ConvNumEnt = strTmp & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
strTmp = ConvNumCent(CInt(iTmp), Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " billion "
Case Else
strTmp = strTmp & " billions "
End Select
ConvNumEnt = strTmp & ConvNumEnt

End Function

Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Byte, byDiz As Byte
Dim strLiaison As String

TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
If Langue = 1 Then
TabDiz(7) = "septante"
TabDiz(9) = "nonante"
ElseIf Langue = 2 Then
TabDiz(7) = "septante"
TabDiz(8) = "huitante"
TabDiz(9) = "nonante"
End If
byDiz = Int(Nombre / 10)
byUnit = Nombre - (byDiz * 10)
strLiaison = "-"
If byUnit = 1 Then strLiaison = " et "
Select Case byDiz
Case 0
strLiaison = ""
Case 1
byUnit = byUnit + 10
strLiaison = ""
Case 7
If Langue = 0 Then byUnit = byUnit + 10
Case 8
If Langue <> 2 Then strLiaison = "-"
Case 9
If Langue = 0 Then
byUnit = byUnit + 10
strLiaison = "-"
End If
End Select
ConvNumDizaine = TabDiz(byDiz)
If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
If TabUnit(byUnit) <> "" Then
ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
Else
ConvNumDizaine = ConvNumDizaine
End If
End Function

Private Function ConvNumCent(Nombre As Integer, Langue As Byte) As String
Dim TabUnit As Variant
Dim byCent As Byte, byReste As Byte
Dim strReste As String

TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix")

byCent = Int(Nombre / 100)
byReste = Nombre - (byCent * 100)
strReste = ConvNumDizaine(byReste, Langue)
Select Case byCent
Case 0
ConvNumCent = strReste
Case 1
If byReste = 0 Then
ConvNumCent = "cent"
Else
ConvNumCent = "cent " & strReste
End If
Case Else
If byReste = 0 Then
ConvNumCent = TabUnit(byCent) & " cents"
Else
ConvNumCent = TabUnit(byCent) & " cent " & strReste
End If
End Select
End Function
 

Lone-wolf

XLDnaute Barbatruc
Bonjour à tous :)

@Jocelyn : il y a un petit problème avec le fichier de Roger. J'ai noté 135.65 € et il met Treize mille cinq cent soixante-cinq dollars au lieu de cent trente-cinq et soixante-cinq centime euro.

Edit: fichier exemple mais sans les devises.
 

Pièces jointes

  • Transposer des chiffres en lettres.xlsm
    20.9 KB · Affichages: 31
Dernière édition:

VIARD

XLDnaute Impliqué
Bonjour Victor :)

Oui tu as raison. Comme je suis en Suisse, le séparateur est un point (Windows par défaut) à la place de la virgule.
Bonjours à tous

C'est la même chose que "M12", sauf que je l'ai adapter à 6 devises que j'utilise, avec un cas particulier,
La devise de "Nouvelle Calédonie" qui n'utilise pas les centimes.
devises utilisés =>"CHF", "€", "$", "£", "CFP", "XOF"

VB:
'===================================
Function chiffrelettre(s, dvise) 'Trouvé sur ExceLabo
'Modifié (s => la somme en chiffre), (dvise => la devise du pays)
' é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
'============================================

A+ Jean-Paul
 

patricktoulon

XLDnaute Barbatruc
re
bonjour a tous
pour le coup j'ai repris mon idée de gestion globale et je l'ai encore plus simplifiée
voila pas besoins d'un array allant jusqu’à quatre-vingt-dix-neuf en toute lettres
il faut seulement de 0 a 19 et de 10 a 90 en toute lettres par pas de 10 bien sur (dix,vingt,trente,etc...
et la tranche allant jusqu'au sextillion (mille,million,milliard,etc.....,sextillion
et j'inclu l'optional sur la recommandation 1990
voila la bête avec sub de test
le dernier test va au sextillion:p
Code:
Option Explicit
Sub test()
    Debug.Print nombre_toutes_lettre2("1,27", True)
    Debug.Print nombre_toutes_lettre2("1000,56", True)
    Debug.Print nombre_toutes_lettre2("100,45", True)
    Debug.Print nombre_toutes_lettre2("45,23")
    Debug.Print nombre_toutes_lettre2("1012101,56")
    Debug.Print nombre_toutes_lettre2("2221,56", True)
    Debug.Print nombre_toutes_lettre2("2437,56", True)
    Debug.Print nombre_toutes_lettre2("3571291245,562", True)
    Debug.Print nombre_toutes_lettre2("1000000", True)
    Debug.Print nombre_toutes_lettre2("1000000000", True)
    Debug.Print nombre_toutes_lettre2("1000000001", True)
    Debug.Print " Et juste pour le fun "
    Debug.Print nombre_toutes_lettre2("951007354823645823543000221130,25")
    Debug.Print ":):):):):):):)"

End Sub

Function nombre_toutes_lettre2(ByVal nombre As String, Optional recomm1990 As Boolean = False)
    Dim dec, unit1, unit10, ms, i&, cen$, dix$, u$, diz$, Part, msx&, T&, ET$, result$
    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("", " mille ", " million ", " milliard ", " Billion ", " Billiard ", " Trillion ", " Quatrillion ", " Quintillion ", " sextillion ", "")
    dec = Split(Replace(nombre, ".", ","), ",")
    For i = 0 To UBound(dec)
              dec(i) = RTrim(Format(dec(i), Application.Rept("000 ", Application.RoundUp(Len(dec(i)) / 3, 0))))
        Part = Split(dec(i), " "): msx = UBound(Part)
        For T = 0 To UBound(Part)
            If ms(msx - T) <> " mille " And ms(msx - T) <> "" Then ms(msx - T) = IIf(Val(Part(T)) > 1, RTrim(ms(msx - T)) & "s ", ms(msx - T))
            cen = Val(Left(Part(T), 1)): dix = Val(Right(Part(T), 2)): diz = Val(Mid(Part(T), 2, 1)): u = Val(Right(Part(T), 1))
            If Val(cen) = 1 Then cen = " cent" Else If Val(cen) > 1 Then cen = unit1(cen) & " cent" Else cen = unit1(Val(cen))
            If dix > 10 And dix < 20 Then diz = 0: u = u + 10
            If dix > 70 And dix < 80 Or dix > 90 And dix < 100 Then diz = diz - 1: u = u + 10
            If dix > 20 And dix < 80 And u Like "*1*" Then ET = " et " Else If u > 0 And diz > 0 Then ET = "-" Else ET = " "
            dix = unit10(diz) & ET & unit1(u)
            If ms(msx - T) = " mille " And Val(Part(T)) = 1 Then dix = " mille ": Part(T) = 0
            result = result & cen & dix & IIf(Val(Part(T)) > 0 And i = 0, ms(msx - T), " ")
        Next
        If UBound(dec) > 0 And i = 0 Then result = result & " virgule "
    Next
    result = IIf(recomm1990, Replace(Application.Trim(result), " ", "-"), Application.Trim(result))
    nombre_toutes_lettre2 = Replace(result, "-virgule-", " virgule ")
End Function
pour la monnaie(devise ) il serait facile de changer"virgule par une toute petite fonction (euro/d'euro)(dollars/de dollars) en fonction du mod 10 de la partie entière en switchant au dessus de mille bien sur dans le cadre de la monnaie reccomm1990 est omis ou false
exemple
mille euro ou dollars
un million d'euro ou de dollars
voila :D
 

patricktoulon

XLDnaute Barbatruc
Bonjour à tous :)

@patricktoulon

Mise à part que Trois-milliards xxxxx virgules Cinq-cent-soixante-Deux n'est pas français, mais tu ne trouve pas que Trois-milliards de virgules c'est trop? :eek::D:D

Une ça ne suffit pas?? :D;)

re
bonjour Lone-wolf
trop de quoi????? si on parle de monnaie je peux comprendre mais si on parle d'autre mesure je vois rien de trop
depuis quand on peut pas descendre en dessous de deux décimales en français ???
et puis après tout rien empêche de faire un round(nombre,2)au départ et ajouter comme je l'ai précisé les 2 3 lignes ou une petite fonction pour la devise
les 2999000 autres virgule je l'ai ai cachéo_O
certe pour etre plus precis i passant a 1 on change de messure en ajoutant un array

centième,dixième,millième etc.....
si tu veux
 

patricktoulon

XLDnaute Barbatruc
si si j'ai pigé les virgules t'inquiet
pour info j'ai une page html de Contrôle qui ne m'a jamais fait défaut
http://www.chiffre-en-lettre.fr/ecrire-nombre-3560256,456
si tu a des idées pour intégrer une/des devises en interne ou externe(dans une fonction séparée) j’étudie
jusqu’à présent j'avais intégré en interne euros dollars dirhams mais je constate que d'autre devises sont utiles a d'autres
merci pour les retours:p
tu pourrais lire le derniers test si l'envie de dormir ne te prends pas en court de lecture ihihihihi
j'aurais aimer que l'on me dise l'erreur, plutôt l'oubli que j'ai fait a fin que l'orthographe soit nikel
l'a tu trouvé???
 

Discussions similaires

Statistiques des forums

Discussions
312 153
Messages
2 085 800
Membres
102 981
dernier inscrit
fred02v