nombre en toutes lettre FR diverse monnaies et autres 7.2

[patricktoulon]

bonjour
pour ceux qui voudraient la même en version "US" avec le même moteur

VERSION US:

Sub test()
 Debug.Print NblettreUS(25378952.75)
Debug.Print NblettreUS(1000.75)
End Sub

Function NblettreUS(chain As String) As String
    Dim t, dixx&, dix&, cxx&, u&, Part, ms, m, Ul, Diz, n&, I&, seg$, cc$, et$, Ss$, R$, md$, dollar$, cent$
    Ul = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen", "hundred")
    Diz = Array("", "Ten", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
    ms = Array("", " vigintillion", " novemdecillion", " octodecillion", " septendecillion", " sexdecillion", " quindecillion", " quattuordecillion", " tredecillion", " duodecillion", " undecillion", " decillion", " nonillion", " octillion", " septillion", " sextillion", " quintillion", " quadrillion", " trillion", " billion", " million", " thousand", "")
    If LCase(chain) Like "*[a-z|:|;|/|\]*" Then NblettreUS = "Invalid Chaine!!": Exit Function
    Part = Split(chain, ","): If Len(Part(0)) > 66 Then NblettreUS = "OutOFF(CAR*66)!!": Exit Function
    dollar = "dollar" & IIf(Part(0) > 1, "s", "")
    dollar = IIf(UBound(Part) > 0, dollar & " and ", "")
    cent = IIf(UBound(Part) > 0, "Cent", ""): If UBound(Part) > 0 Then If Part(1) = 0 Then Part = Array(Part(0)): cent = "": dollar = Replace(dollar, "and", "")
    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, " hundred ", "")
                        If dixx > 9 And dixx < 20 Then dix = 0: u = u + 10
               md = ms(m):
            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 dollar = ""
        R = R & IIf(n = 0, dollar, cent): If n = 1 Then If Part(1) > 1 Then R = R & "s" & IIf(Part(0) = 0, " dollar", "")
        If Trim(R) = "" Then R = ""
    Next n
    NblettreUS = Application.Trim(R)
End Function

 

[Jouxte]

Bonjour à toutes et tous,

Merci pour ce très beau travail qui respecte les règles grammaticales pour le tiret.
J'ai néanmoins deux petites remarques :
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.
Par ailleurs il y a un petit bug sur les milliers
voir ci-dessous.
Bonne soirée.

126,0036​	cent vingt-six euros et trente-six Centimes
1276,036​	un mille deux cent soixante-seize euros et trente-six Centimes

 

[Jouxte]

Re,
Encore un détail :
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

 

[patricktoulon]

patricktoulon a mis à jour somme euro en toutes lettre FR Version2 avec une nouvelle version :

refonte de la fonction

Bonjour a tous
après plusieurs bizarreries rapportées pas les utilisateurs ( que je n'ai pas réussi a reproduire)
j'ai décidé de réécrire la fonction
donc voici la version 4.0
refonte du moteur de conversion simplifié dans un select case
Ajout du moteur d'association avec la mesure (monnaie ou autres) simplifié dans un select case
merge de la version sans mesure(3 chiffres après la virgule)avec celle ci ( 2 en un)

monnaie et mesure déjà intégrées

'sans mesure...

Lire la suite de cette mise à jour...

 

[Jouxte]

patricktoulon a mis à jour somme euro en toutes lettre FR Version2 avec une nouvelle version :

refonte de la fonction



Lire la suite de cette mise à jour...

Bonjour patricktoulon, le Forum,

Merci pour cette nouvelle mouture.
Pour information, pour les euros, il manque le pluriel
: pluriel = "s"

Curieusement, (bien que je n'aurais vraisemblablement jamais à aller jusque là), je ne peux pas aller au delà des billions.

Serait-il possible d'ajouter une monaie "féminine" comme la couronne ou la livre ?

Merci encore, bonne journée.

 

[Jouxte]

Re,
Précision :
au delà du billion fonctionne si le montant est dans la formule mais pas si le montant est dans une cellule voisine

 

[patricktoulon]

attend j'ai fait mieux
la version 4.2 avec d'autre monnaie et un choix en plus du mode d'arrondie sur 2 et 3 décimales

donne moi le nom des décimales(centime) de la couronne et son nombre de décimales a considérer aussi

 

[patricktoulon]

Re,
Précision :
au delà du billion fonctionne si le montant est dans la formule mais pas si le montant est dans une cellule voisine

c'est normal au delà du billion vba abrégé les nombre il faut que ce soit en string

 

[Jouxte]

re,

la couronne suedoise se subdivise en 100 La couronne est subdivisée en 100 öre (invariable)

 

[patricktoulon]

ok c'est intégré
un milliard de Couronne "s" ou pas "s"

 

[Jouxte]

un milliard de Couronne avec "s"

 

[patricktoulon]

ok j'enregistre
demain je met la V 5.0 elle c'est vachement étoffée

 

[patricktoulon]

bonjour @Jouxte
une dernière chose on dit une couronne ou un couronne

 

[Jouxte]

bonjour @Jouxte
une dernière chose on dit une couronne ou un couronne

Bonjour patricktoulon, le Forum

C'est une Couronne eu un öre .

Bonne journée.

 

[Jouxte]

Correction :
C'est une Couronne et un öre .