XL 2019 Conversion en lettre

bauerjackob

XLDnaute Junior
Bonjour
J'ai utilisé lors de mon fichier (joint) une conversion en lettre via VBA. un peu bizzare quand meme il met un valeur d'erreur dans le cas 1 (dessus collorie en jaune) mais dans le cas 2 (dessous colorie en bleu) c'est bien fonctionné. j'essaie de trouver la solution a ce probleme mais je n'arrive pas. Pourriez vous m'aider?
 

Pièces jointes

  • ESSAI CO.xlsm
    32.6 KB · Affichages: 14
Solution
Bonjour à tous

L'erreur vient d'ici

1656613036107.png


Je pense qu'il faut réapprendre à compter à Microsoft !!o_O

Riton t'as donné une solution de contournement ;)

1656613626935.png


@Phil69970

Lolote83

XLDnaute Barbatruc
Bonjour,
Le code VBA est protégé, personne ne pourra donc donner une explication sans avoir accès au code. Je dis cela juste pour les futurs "chercheurs" car je ne sais pas si j'y arriverais.
Il serait donc judicieux de remplacer le fichier joitn par le même "déprotégé" de son VBA.
@+ Lolote83
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,

Pas trouvé, mais quelques pistes.
Si en F8 on écrit :
1- 20385, c'est ok : vingt mille trois cent quatre-vingt-cinq Euro
2- =F3+F7 , #Valeur
3- =CNUM(TEXTE(F7+F3;"@")), alors OK.
or CNUM(TEXTE) c'est la valeur initiale, et il n'y a pas de soucis ou de format.

Un peu bizarre, YaPuKa attendre une version déplombée du VBA.:)
 

soan

XLDnaute Barbatruc
Inactif
Bonsoir Phil, le fil,

Je pense qu'il faut réapprendre à compter à Microsoft !! o_O

tu as écrit ça à propos du nombre 13.1999999999998000000000000 entouré en rouge sur l'image ; mais là, pour une fois (ou presque), le pauv' Microsoft n'y est pour rien ! ;) car même l'ordinateur le plus puissant ne peut pas stocker un nombre fractionnaire avec une précision infinie ! de plus, le stockage d'un nombre, quelque soit la méthode de représentation utilisée, aboutit toujours, inévitablement, à un codage en binaire ! donc ça aussi, ça induira forcément une perte de précision ! c'est impossible de faire autrement !

le nombre ci-dessus est un nombre fractionnaire en simple précision (mis dans une variable de type « Single », caractère de type « ! »), d'où la série finale de zéros ; s'il avait été mis dans une variable numérique en double précision (type « Double », caractère de type « # »), le nombre de chiffres significatifs après la virgule aurait été plus important ; regarde aussi le type spécial « Currency » (caractère de type « @ ») ; mais de toute façon, comme déjà dit au paragraphe ci-dessus, la précision ne pourra jamais être infinie.​

soan
 
Dernière édition:

Phil69970

XLDnaute Barbatruc
Le fil

Soan

En fait j'ai juste essayer de trouver d’où pouvait venir l'erreur de son fichier.
J'ai pris le convertisseur de @patricktoulon et j'ai eu cela .

1656616855706.png


J'ai essayé de tout passer en format monétaire pour voir que cela ne changeait rien

1656617209269.png


Partant de la j'ai modifié en rajoutant des décimales pour voir de quelles cellules provenait l'erreur d'un calcul somme toute assez simple.

@Phil69970
 

soan

XLDnaute Barbatruc
Inactif
@Phil69970

essaye : =NblettreFR2020(ARRONDI($F8;2);"euro")

ça donnera peut-être "vingt mille trois cent quatre-vingt cinq euros et zéro centime" ?

ainsi, l'arrondi à 2 décimales devrait éliminer les erreurs dues au manque de précision du stockage ; mais de toute façon, c'est en amont, sur la facture d'électricité elle-même, qu'il aurait fallu utiliser un arrondi, à bon escient. (donc sur les nombres fractionnaires)

soan
 

patricktoulon

XLDnaute Barbatruc
bonjour a tous
ma fonction 2020 si il y a un nombre décimal xx , 00 les centimes ne sont pas pris en compte

vous pouvez aussi essayer la toute dernière francophone:)
 

patricktoulon

XLDnaute Barbatruc
re
pour le coup
j'ai fait une petite mise a jour sur la 2020
en exclu
VB:
Sub testj()
 MsgBox "arrondi inférieur de 3.99" & vbCrLf & NblettreFR2020(3.99, "euro", 0) '0=arrondi inferieur (RoundDown)                                                *
 MsgBox "arrondi automatique de 3.99" & vbCrLf & NblettreFR2020(3.99, "euro", 1) '1=arrondi automatique (round)                                                  *
 MsgBox "arrondi automatique de 3.45" & vbCrLf & NblettreFR2020(3.45, "euro", 1) '1=arrondi automatique (round)                                                  *
MsgBox "arrondi supérieur de 3.99" & vbCrLf & NblettreFR2020(3.99, "euro", 2) '2=arrondi superieur(RoundUp)                                                   *
 MsgBox "tel quel" & vbCrLf & NblettreFR2020(3.99, "euro", 3) '3=tel quel                                                   *
End Sub

VB:
'********************************************************************************
'                      NOMBRE EN LETTRE version Francaise                       *
'auteur: patricktoulon sur exceldownload                                        *
'version 1.0 à 6.3 supprimées                                                   *
'version 7.2                                                                    *
'Date version 15 novembre 2020------------------------                          *
'refonte complete du moteur de convertion (simplifié dans un select case)       *
'Ajout  du moteur d'association a une mesure(monnaie ou autre)                  *
'merge des modeles nombre et monnaie en une seule fonction                      *
'sans association ou monnaie ou mesure concernée 3 chiffres après la virgule    *
'on va toujours jusqu'a 999 deciliards (9999.....) EN STRING!!!!!               *
'on va jusqu'au billion en formule et en long en VBA                            *
'because vba et excel abrege les nombre au delas!!!!                            *
'                                                                               *
'                <<<monnaie et mesure deja intégrées>>>                         *
'                                                                               *
'sans mesure        (3 chiffres après la virgule presents ou pas)(pas d'arrondi)*
'EURO               (2 chiffres après la virgule)(pas d'arrondi)                *
'DOLLAR             (2 chiffres après la virgule)(pas d'arrondi)                *
'dinar koweiti      (3 chiffres après la virgule)(pas d'arrondi)                *
'dinar tunisien     (3 chiffres après la virgule)(pas d'arrondi)                *
'dirham marocain    (2 chiffres après la virgule)(pas d'arrondi)                *
'kilo               (3 chiffres après la virgule)(pas d'arrondi)                *
'                                                                               *
'mise a jour 26/10/2020-------------------------                                *
'ajout du choix de l'arrondi 3 eme argument 4 choix possibles (-1,0,1,2)        *
'-1 ou pas d'argument =pas d'arrondi (par defaut si omis)                       *
'0=arrondi inferieur (RoundDown)                                                *
'1=arrondi automatique (round)                                                  *
'2=arrondi superieur(RoundUp)                                                   *
'                                                                               *
'mise a jour 27/10/2020--------------------------                               *
'Ajout de la monnaie suedoise "le couronne" (demande de @Jouxte)(XLD)           *
'                                                                               *
'mise a jour 27/10/2020--------------------------                               *
'refonte du moteur d'arrondi simplifié                                          *
'néanmoins un bug reside dans le multiple de 1 pour l'entier vallant 1          *
'avec l'arrondi vba,superieur,inférieur                                         *
'                                                                               *
'mise a jour 28/10/2020---------------------------                              *
'correction du bug de l'arrondi en bloquant l'arrondi en dessous 1.10(inutile)  *
'                                                                               *
'                                                                               *
'*********************************************************************************************************
'                                   exemples d'appel de la fonction                                       *
'                                                                                                        *
'Debug.Print NblettreFR2020( [nombre] , [monnaie ou nombre de decimal] , [mode d'arrondi] )              *
'Debug.Print NblettreFR2020( [nombre] )             '2 decimales automatique  pas d'arrondi              *
'Debug.Print NblettreFR2020( [nombre],[2 ou 3] )    '2 ou 3 decimales pas d'arrondi                      *
'Debug.Print NblettreFR2020([nombre], decRound:=2)  '2 decimales forcées arrondi au 10eme superieur      *
'Debug.Print NblettreFR2020([nombre], ,2)           '2 decimales forcées arrondi au 10eme superieur      *
'Debug.Print NblettreFR2020([nombre],2 )            '2 decimales forcées et pas d'arrondi                *
'Debug.Print NblettreFR2020([nombre],3,2 )          '3 decimales forcées arrondi au 10eme superieur      *
'Debug.Print NblettreFR2020([nombre],3,1 )          '3 decimales forcées arrondi automatique VBA         *
'Debug.Print NblettreFR2020([nombre],3,0 )          '3 decimales forcées arrondi au 10eme inférieur      *
'                                                                                                        *
'*********************************************************************************************************
'****************************************************************************************************************
'                                   exemple d'utilisation en formule                                            *
'                                                                                                               *
'                                            à 2 decimales                                                      *
'=NblettreFR2020(A1,2,)     'lecture tel quel 2 decimales considérées(la 3eme est occulté si presente)          *
'=NblettreFR2020(A1,2,0)    'arrondi inférieur 2 decimales considérées(la 3eme est occulté si presente)         *
'=NblettreFR2020(A1,2,1)    'arrondi automatique 2 decimales considérées(la 3eme est occulté si presente)(+/-5) *
'=NblettreFR2020(A1,2,2)    'arrondi supérieur 2 decimales considérées(la 3eme est occulté si presente)         *
'                                                                                                               *
'                                             à 3 decimales                                                     *
'si moins de 3 elle sont ajoutées"#00"(reconsidération de l'echelle de la tranche)                              *
'=NblettreFR2020(A1,3,))    'lecture tel quel 3 decimales considérées                                           *
'=NblettreFR2020(A1,3,0))   'arrondi inférieur 3 decimales considérées                                          *
'=NblettreFR2020(A1,3,1))   'arrondi automatique 3 decimales considérées (+/-5)                                 *
'=NblettreFR2020(A1,3,2))   'arrondi supérieur 3 decimales considérées                                          *
'                                                                                                               *
'                                                                                                               *
'                                           avec les monnaies                                                   *
'                                                                                                               *
'=NblettreFR2020($A2;"Couronne")    'monnaie couronne 2 decimales       (couronne/öre)(féminin)                 *
'=NblettreFR2020($A2;"dinark")      'monnaie dinar kuweiti 3 decimales  (dinar/fil)                             *
'=NblettreFR2020($A2;"dinar")       'monnaie dinar  3 decimales         (dinar/millime)                         *
'=NblettreFR2020($A2;"Dollar")      'monnaie US 2 decimales             (dollar/cent)                           *
'=NblettreFR2020($A2;"euro")        'monnaie europe 2 decimales         (euro/centime)                          *
'=NblettreFR2020($A2;"£")ou"Ls"     'monnaie Livre Sterling 2 decimales (livre sterling/(peny/pence))           *
'=NblettreFR2020($A2;"dirhammarocain") 'monnaie marocaine 2 decimales   (dirham/rial)                           *
'                                                                                                               *
'                                                                                                               *
'                                           D'autres mesures                                                    *
'                                                                                                               *
'=NblettreFR2020($A2;"kilo")        'poids   3 decimales         (kilo/gramme)                                  *
'                                                                                                               *
'                                                                                                               *
'                                   d'autre a venir à la demande :)                                             *
'mise a jour
'date 01/07/2022
'ajout de la prise en compte du nombre tel quel  (case 3)
'****************************************************************************************************************


Option Explicit

Public Function NblettreFR2020(chain As String, Optional MonnaieOuNombreDeDecimale As String = "", Optional decRound As Long = -1) As String
    Dim t, p&, q$, cent$, cx&, d$, u$, Part, ms, Ul, Diz, I&, et$, centime, w$, x&, z, z1, texte, prefixe$, pluriel$, AvecCent$, fric, dec
    Ul = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
    Diz = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix", "cent")
    ms = Array("", " decilliard", " decillion", " nonilliard", " nonillion", " octillard", " octillion", " septilliard", " septillion", " sextilliard", " sextillion", " quintilliard ", " Quintillion", " quadrilliard", " quadrillion", " trilliard", " trillion", " Billiard", " billion", " milliard", " million", " mille", "")
    chain = Replace(chain, ".", ",")    'au cas ou
    If Not IsNumeric(chain) Then NblettreFR2020 = "Invalid Chain!!!": Exit Function
    Part = Split(chain, ","): If Len(Part(0)) > 66 Then NblettreFR2020 = "OutOFF(CAR*66)!!": Exit Function
    fric = MonnaieOuNombreDeDecimale
    '--------------------------------------------------------------------------------------------
    'moteur d'association
    Select Case LCase(fric)
    Case "", 2: fric = IIf(UBound(Part) > 0, "virgule", ""): centime = "": cx = 2: pluriel = ""
    Case 3: fric = IIf(UBound(Part) > 0, "virgule", ""): centime = "": cx = 3: pluriel = ""
    Case "euro": centime = "centime": cx = 2: prefixe = "d'": AvecCent = " et":: pluriel = "s":    ' decRound = -1
    Case "dollar": centime = "cent": cx = 2: prefixe = "de ": pluriel = "s": AvecCent = " et":    ' decRound = -1
    Case "dinark", "dinar": decRound = -1: centime = IIf(fric = "dinark", "fil", "millime"): fric = "dinar": cx = 3: prefixe = "de ": pluriel = "s": AvecCent = " et"
    Case "kilo": decRound = -1: centime = "gramme": cx = 3: prefixe = "de ": pluriel = "s": AvecCent = " et"
    Case "dirhammarocain": fric = "dirham": centime = "rial": cx = 2: pluriel = "s": AvecCent = " et": prefixe = "de "
    Case "£": fric = "Livre Sterling": prefixe = "of ": AvecCent = " et ": pluriel = "": cx = 2: If UBound(Part) > 0 Then If Part(1) > 1 Then centime = "pence" Else centime = "peny"
    Case "couronne": centime = "Öre": cx = 2: prefixe = "de ": AvecCent = " et":: pluriel = "": fric = IIf(Part(0) > 1, fric & "s", fric)
        '......
        '.....
    End Select
    '--------------------------------------------------------------------------------------------
    'Moteur de l'arrondi
    If CDbl(chain) < 1.1 Then decRound = -1    '(inutile de descendre en dessous)
    If decRound <> -1 Then
        Select Case decRound
        Case 0: chain = WorksheetFunction.RoundDown(chain, cx - 1):
        Case 1: chain = WorksheetFunction.Round(chain, cx - 1):
        Case 2: chain = WorksheetFunction.RoundUp(chain, cx - 1):
        Case 3: chain = chain
        End Select
        Part = Split(chain, ",")
    End If
    If UBound(Part) > 0 Then Part(1) = Left(Part(1), cx)
    '--------------------------------------------------------------------------------------------


    fric = IIf(Val(Part(0)) > 999000 And Val(Right(Part(0), 6)) = 0, prefixe & fric, fric)    'ajout du prefixe a partir de 1 million si mod 10
    fric = IIf(Part(0) > 1, fric & pluriel, fric) & IIf(UBound(Part) > 0, AvecCent, "")
    If UBound(Part) > 0 Then Part(1) = Left(Part(1), cx): centime = IIf(Part(1) > 1 And centime <> "", centime & pluriel, centime)


    If Val(Part(0)) = 0 Then NblettreFR2020 = "zero" & fric
    For I = 0 To UBound(Part)
        If I = 0 Then
            t = Split(Trim(Format(Part(I), Application.Rept(" @@@", (Len(Part(I)) / 3) + 1))), " ")
        Else
            t = Array(CStr(Left(Part(1) & "00", cx)))
        End If
        cent = "": d = "": u = ""
        For p = UBound(t) To 0 Step -1
            '--------------------------------------------------------------------------------------------
            'Moteur de conversion
            cent = "": d = "": u = "": z1 = t(p): z = t(p)
            If z >= 100 Then cent = IIf(Left(z, 1) > 1, Ul(Left(z, 1)) & " cent", "cent")
            If z Mod 100 = 0 And z > 100 Then cent = cent & "s" Else cent = cent & " "

            z = Right(z1, 2)

            Select Case True
            Case z < 20: d = "": u = Ul(z)    'si en dessous de 20 on passe directement par l'array ul
            Case z > 70 And z < 80: et = IIf(Right(z, 1) = 1, " et ", "-"): d = Diz(Left(z, 1) - 1): u = et & Ul(Right(z, 1) + 10)    'de 71 a 79 c'est dizaine-1 et unité+10 pour 71 et =" et " sinon et="-"
            Case z = 80: d = Diz(Left(z, 1)) & "s"    'exeption seul le 80 tout seul prends le "s"
            Case z > 90: d = Diz(Left(z, 1) - 1): u = "-" & Ul(Right(z, 1) + 10)    'de 91 a 99 c'est dizaine-1 et unité+10 le et est automatiquement "-"
                'pour tout le reste c'est dizaine et unité
            Case Else: et = IIf(Right(z, 1) = "0" Or z < 10, "", IIf(Right(z, 1) = 1, "-et-", "-")): d = Diz(Left(z, 1)): u = et & Ul(Right(z, 1))    'If Right(z, 1) = "0" Or z < 10 Then et = "" Else et = "-"
            End Select
            'fin de conversion
            '--------------------------------------------------------------------------------------------
            'compile du segment
            t(p) = Trim(cent & d & u) & " " & IIf(I = 0, IIf(z1 > 0, ms(UBound(ms) - x) & IIf(z1 > 1, IIf(x > 1, "s ", " "), " "), " "), " ")
            x = x + 1    'itération pour soustraire index de "ms"
            If t(p) = "un  mille " Then t(p) = "mille "
            If t(p) = "  " And Val(Part(I)) = 0 Then t(p) = "Zéro"
            'Debug.Print t(p)
        Next
        If I = 0 Then q = fric Else q = centime    'association mesure accordée
        texte = texte & Application.Trim(Join(t, "")) & " " & q & " "
    Next

    '------------------------------------------------------------------------
    'correctif féminin/masculin( pour l'unité de fric et centime) si besoins pour certaines monnaies
    Select Case True
    Case InStr(1, LCase(texte), "couronne", vbTextCompare) > 0: texte = Replace(texte, "un Couronne", "une Couronne")
        'etc....
    End Select
    '------------------------------------------------------------------------
    'compilation et régularisation des espaces de la chaine finale
    texte = Application.Trim(texte): If Right(texte, 7) = "virgule" Then texte = Replace(texte, " virgule", "")
    'Debug.Print texte'juste pour voir
    NblettreFR2020 = texte    'RETURN!!!
End Function

bonne journée à tous
 

Discussions similaires

Réponses
6
Affichages
469

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG