XL 2019 Convertir des chiffres en lettres

sebbbbb

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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

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

VB:
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

XLDnaute Impliqué
Bonjour Jouxte, Patrick, Sebbbbb et à toutes et tous

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

VB:
'===================================
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

XLDnaute Occasionnel
Bonsoir Patricktoulon,
J'ai cru comprendre dans le code qu'à partir d'un million il devrait être écrit : un million d'euros ou un million de dollars.
Chez moi il est écrit un million euros
à partir du billiard il me met #valeur (je pense que je n'aurais jamais à l'utiliser ;))
Bonne soirée.
 

Jouxte

XLDnaute Occasionnel
Bonjour à toutes et tous,

J'ai essayé d'intégrer les £ dans le code de Patricktoulon (nBlettre_methode_globale), mais je me heurte à un problème pour la monnaie britannique car c'est une livre (1000001= un million une livre) mais un penny et deux pence (invariable au pluriel)

Étrange, le bug que je rencontre avec l'absence du d' du million d'euros avec la formule dans une cellule n'existe pas dans la msgbox de la macro testx.

Bonne nuit à toutes et tous
 

patricktoulon

XLDnaute Barbatruc
re
bonjour c'est étonnant surtout que ce problème du d' je ne l'ai pas
pour les monnaies dont tu a des soucis ,à toi d'ajouter une ligne de code pour le "s" ou pas

ou tout simplement reprendre mon moteur de traduction (nombre/lettre) et te faire ta propre fonction
je vais la refaire avec une autre méthodes quand j'aurais le temps
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas