Discussion :

[patricktoulon]

Bonjour
je suis revenu sur mes deux variantes (fonctions) chiffre en lettres avec et gestion de l'orthographe séquentiel mais n'arrondie pas au supérieur les décimales

la deuxième plus approfondie avec gestion globale de l'orthographe du nombre en texte et de la monnaie

voici la première

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

on la testera comme suit en vba

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub test52()
    Debug.Print nombre_en_lettre5("1000000,43", " euro", " centime")
    Debug.Print nombre_en_lettre5("154316457894000000.43", " dollar", " cent")
end sub

dans une cellule on mettra ce modele de formule

=SI(A1=0;" ";nombre_en_lettre5(A1;" dollar";" cent"))

************************************************************************************************
et voila la petite dernière dite méthode globale du traitement de l'orthographe du nombre en texte et de la monnaie
celle ci par contre arrondie le décimal eu supérieur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
35
36
37
38
 
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
    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
    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")
    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
End Function

on la testera en VBA comme suit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub tes2()
    debug.print nBlettre_methode_globale(256354.2153, "euro", True)             ' euro
    debug.print nBlettre_methode_globale(10000000.2153, "euro", True)           ' euro
    ndebug.print Blettre_methode_globale(10000000.2153, "Dirham", True)       ' dirham
    debug.print  nBlettre_methode_globale(10000000.2153, "dollar", True)        ' dollar
    debug.print Blettre_methode_globale(1.1, "Dirham", True)                           ' dirham
   debug.print nBlettre_methode_globale(12563.2365)                                     ' pas de monnaie 
   debug.print nBlettre_methode_globale(1.01)                                                ' pas de monnaie 
End Sub

dans une cellule on mettra ce model de formule

=SI(A13=0;" ";nBlettre_methode_globale((A13);"euro";1))

qu 'en pensez vous ?

[grisan29]

bonjour Patricktoulon

excellente ta fonction qui fonctionne très bien après correction de 3 fautes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 ndebug.print Blettre_methode_globale(10000000.2153, "Dirham", True)       ' dirham
    debug.print  nBlettre_methode_globale(10000000.2153, "dollar", True)        ' dollar

ca fonctionne mieux ainsi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Debug.Print nBlettre_methode_globale(10000000.2153, "Dirham", True)       ' dirham
    Debug.Print nBlettre_methode_globale(10000000.2153, "dollar", True)         ' dollar

Pascal

[patricktoulon]

re

Bonjour Pascal ca faisait longtemps
oui peut être que j'ai manger des caractères dans les tests mais la fonctions elle fonctionne a merveille je m'en sert pour mon app pro

je pensais a toi justement toi qui utilise mon userform mailer pro

il a subit une transformation majeure il est en 2 version maintenant (pro/publique)en finition en ce moment ca va décoiffer tu va tomber sur le c....

[grisan29]

bonjour Patricktoulon
je sais que ton code fonctionne bien car je l'ai mis sur le classeur que bluemonkey m'a fait et c'est ce classeur qui ma éjecter du forum, parce que bluemonkey c'est investi jusqu'au bout et le pire dans tout cela c'est qu'on ne le vois plus depuis, et cela a rajouter un peu plus pour mon éviction
j'ai pris ton code car j'utilise celui que j'avais trouvé sur exelabo car une fonction est plus plus performant qu'un module

question du maileur j'ai déjà vu les post que tu as initié a ce sujet ce sera du top, comme tu as toujours su le faire, mais j'espère qu'il ne fonctionnera pas avec IE c'est ce qui me plait dans l'ancien

Pascal

[bruxmu]

Bonjour,

Bravo pour cette fonction qui va bien me rendre service (et merci à grisan29 de me l'avoir fait découvrir).

Je suggère 2 petites améliorations :
1/ supprimer l'espace initial dans le texte résultat
2/ éviter les espaces doubles ou triples dans le texte résultat

Mais tel quel, c'est déjà précieux !