Microsoft 365 conversion chiffres en lettres qui m'enlève toujours 5

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaite une belle journée :)

Je me tourne une nouvelle fois vers nos ténors.
J'ai un code pour convertir les chiffres en lettres.
Il semble fonctionner normalement mais il m'enlève toujours 5 et je n'arrive pas à trouver ou modifier le code :
VB:
Function NumText(Nombre As Currency, Optional Unité As String, Optional no_chiffres As Integer, Optional SousUnité As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
    PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
    TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & " " & TxtDécimal & " " & SousUnité
End Function

Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
    NumTextEntier = "Zéro "
Else
    While Entier > 0
        Classe = Entier - Int(Entier / 1005) * 1005
        NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
        no_Classe = no_Classe + 1
        Entier = Int(Entier / 1005)
    Wend
End If
End Function

Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante", "quatre vingt", "quatre vingt")
TUnités = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", _
"dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", "dix huit", "dix neuf")
   If Classe = 0 Then Exit Function
    ' Pas de un pour mille
    If Classe = 1 And no_Classe = 1 Then
        TxtClasse = "mille "
        Exit Function
    End If
    '
    Centaine = Classe \ 100
    Unités2Chiffres = Classe Mod 100
    Dizaine = Unités2Chiffres \ 10
    Unité = Unités2Chiffres Mod 10
    ' Les centaines -----
    If Centaine = 1 Then
            TxtCentaines = "cent "
    ElseIf Centaine > 1 Then
            TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
    End If
    ' Les dizaines ------
    TxtDizaines = Tdizaines(Dizaine)
    If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
        TxtDizaines = TxtDizaines & " et"
    End If
    If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
        Unité = Unité + 10: Dizaine = 0
    End If
    TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
    If Unités2Chiffres > 19 And Unité > 0 Then
            TxtDizaines = TxtDizaines & " "
    ElseIf Dizaine > 0 Then
            TxtDizaines = TxtDizaines & " "
    End If
    ' Les unités -------- Espace si unité > 0
    TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
    ' La classe --------- un s sauf pour mille
    TxtClasse = TClasses(no_Classe) & IIf(no_Classe > 1 And Classe > 1, "s", "") & IIf(no_Classe > 0, " ", "")
    ' Résultat ----------
    TxtClasse = TxtCentaines & TxtDizaines & TxtUnités & TxtClasse
End Function
Pourriez-vous m'aider ?
Je joins un fichier test et je continue à chercher.

je vous remercie,
Amicalement,
lionel,
 

Pièces jointes

  • test_chiffres.xlsm
    22.1 KB · Affichages: 15
Dernière édition:

patricktoulon

XLDnaute Barbatruc
voilà voilà
vive le chocolat suisse et les fritte 😁
la encore je varie les syntaxes pour tester la gestion syntaxe
il y a donc maintenant un argument supplémentaire
suisse :c'est "suisse" ou "se"
belgique :c'est "belgique" ou "be"

j'ai pris en considération les deux écritures pour les belges ("octante" /"quatre-vingt")
1638266187245.png


VB:
'*************************************
'nombre lettre to nombre en numerique
'auteur :patricktoulon
'version1.2 17/06/2019
' en cours de developpements
'version finale 1.3 29/11/2021
'mise ajour
'ajout de la prise en charge des centimes 29/11/2021
' ajout de  de plusieur syntaxes autorisée
'ajout de la suisse et la belgique
'************************************
Option Explicit
Sub test()
    MsgBox NblettreToNum("sept-cent-trente-huit Euros et  dix-huit")
End Sub

Function NblettreToNum(chaine As String, Optional region As String = "fr")
    Dim LettreFr, LettresS, LettresB, Lettres, chiffre, tranche, tranchenum, x, z&, i&, a&, t, q&, tc, StringOper, calcul, divi&
    LettreFr = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                     "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                     "soixante", "soixante dix", "quatrevingt", "quatrevingt", "quatrevingtdix", "cent", "cents")

    LettresS = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                    "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                    "soixante", "septante", "huitante", "huitante", "nonante", "cent", "cents")

    LettresB = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                    "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                    "soixante", "septante", "octante", "quatrevingt", "nonante", "cent", "cents")

    'etc..etc..
    Select Case LCase(region)
    Case "fr": Lettres = LettreFr
    Case "suisse", "se": Lettres = LettresS
    Case "belge", "be": Lettres = LettresB
        'etc..etc...
    End Select

    chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 80, 90, 100, 100)

    tranche = Array("mille", "million", "milliard"): tranchenum = Array("*1000" & vbCrLf, "*1000000" & vbCrLf, "*1000000000" & vbCrLf)
    x = Application.Trim(LCase(chaine))
    'nettoyage grammatical FR
    For i = 4 To UBound(Lettres): x = Replace(x, Lettres(i) & "s", Lettres(i)): Next    'pour les "s" des nombres en lettres
    x = Replace(x, "€uro", "euro")
    If x Like "*centime*" And Not x Like "*euro*" Then divi = 100
    If x Like "*centime*" And x Like "*,*" Then divi = 1
    x = Replace(Replace(Replace(Replace(x, "euros", "euro"), "zéro", "zero"), "-", " "), "euro et", ",")
    If Right(x, 4) = "euro" Then x = Replace(x, "euro", "")
    If Mid(x, InStr(1, x, "euro") + 2) <> "" Then x = Replace(x, "euro", ",")
    x = Replace(Replace(Replace(Replace(Replace(Replace(x, "virgule", ","), "virgule", ","), " et ", " "), "d'", " "), "euro", ""), "€", "")
    x = Replace(Replace(Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt"), "centimes", ""), "centime", "")    'cas particulier de quatr vingt(s)
    For i = 0 To UBound(tranche): x = Replace(x, tranche(i), tranchenum(i)): Next
    x = Split(Application.Trim(x), ",")
    For z = 0 To UBound(x)
        'on a les tranches
        t = Split(x(z), vbCrLf)
        For i = 0 To UBound(t)
            tc = Split(Application.Trim(t(i)), " ")
            For a = 0 To UBound(tc)
                If tc(0) = "cent" Then tc(0) = 100
                If InStr(1, tc(a), "cent") = 0 Then
                    q = Application.IfError(Application.Match(tc(a), Lettres, 0), 0)
                    If q > 0 Then tc(a) = IIf(a > 0, "+", "") & chiffre(q - 1)
                Else
                    tc(a - 1) = Val(tc(a - 1)) * 100: tc(a) = ""
                End If
            Next
            t(i) = Join(tc)
            If InStr(1, t(i), "*") > 0 Then t(i) = "(" & Replace(t(i), "*", ")*")
            t(i) = "(" & t(i) & ")"
        Next
        StringOper = Replace((Replace(Replace(Join(t, "+"), "+()", ""), "()*", "")), " ", "")
        calcul = calcul + IIf(z = 1, Evaluate(StringOper) / 100, Evaluate(StringOper))
        'Debug.Print chaine & vbCrLf; "l'operation " & IIf(z = 0, "entier", "centime") & vbCrLf & StringOper & vbCrLf & "Résultat " & calcul
        StringOper = ""
    Next
    'Debug.Print "**********************************"
    If divi = 100 Then calcul = calcul / 100
    NblettreToNum = calcul
End Function
 

phil66

XLDnaute Junior
voilà voilà
vive le chocolat suisse et les fritte 😁
la encore je varie les syntaxes pour tester la gestion syntaxe
il y a donc maintenant un argument supplémentaire
suisse :c'est "suisse" ou "se"
belgique :c'est "belgique" ou "be"

j'ai pris en considération les deux écritures pour les belges ("octante" /"quatre-vingt")
Regarde la pièce jointe 1123341

VB:
'*************************************
'nombre lettre to nombre en numerique
'auteur :patricktoulon
'version1.2 17/06/2019
' en cours de developpements
'version finale 1.3 29/11/2021
'mise ajour
'ajout de la prise en charge des centimes 29/11/2021
' ajout de  de plusieur syntaxes autorisée
'ajout de la suisse et la belgique
'************************************
Option Explicit
Sub test()
    MsgBox NblettreToNum("sept-cent-trente-huit Euros et  dix-huit")
End Sub

Function NblettreToNum(chaine As String, Optional region As String = "fr")
    Dim LettreFr, LettresS, LettresB, Lettres, chiffre, tranche, tranchenum, x, z&, i&, a&, t, q&, tc, StringOper, calcul, divi&
    LettreFr = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                     "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                     "soixante", "soixante dix", "quatrevingt", "quatrevingt", "quatrevingtdix", "cent", "cents")

    LettresS = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                    "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                    "soixante", "septante", "huitante", "huitante", "nonante", "cent", "cents")

    LettresB = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                    "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                    "soixante", "septante", "octante", "quatrevingt", "nonante", "cent", "cents")

    'etc..etc..
    Select Case LCase(region)
    Case "fr": Lettres = LettreFr
    Case "suisse", "se": Lettres = LettresS
    Case "belge", "be": Lettres = LettresB
        'etc..etc...
    End Select

    chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 80, 90, 100, 100)

    tranche = Array("mille", "million", "milliard"): tranchenum = Array("*1000" & vbCrLf, "*1000000" & vbCrLf, "*1000000000" & vbCrLf)
    x = Application.Trim(LCase(chaine))
    'nettoyage grammatical FR
    For i = 4 To UBound(Lettres): x = Replace(x, Lettres(i) & "s", Lettres(i)): Next    'pour les "s" des nombres en lettres
    x = Replace(x, "€uro", "euro")
    If x Like "*centime*" And Not x Like "*euro*" Then divi = 100
    If x Like "*centime*" And x Like "*,*" Then divi = 1
    x = Replace(Replace(Replace(Replace(x, "euros", "euro"), "zéro", "zero"), "-", " "), "euro et", ",")
    If Right(x, 4) = "euro" Then x = Replace(x, "euro", "")
    If Mid(x, InStr(1, x, "euro") + 2) <> "" Then x = Replace(x, "euro", ",")
    x = Replace(Replace(Replace(Replace(Replace(Replace(x, "virgule", ","), "virgule", ","), " et ", " "), "d'", " "), "euro", ""), "€", "")
    x = Replace(Replace(Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt"), "centimes", ""), "centime", "")    'cas particulier de quatr vingt(s)
    For i = 0 To UBound(tranche): x = Replace(x, tranche(i), tranchenum(i)): Next
    x = Split(Application.Trim(x), ",")
    For z = 0 To UBound(x)
        'on a les tranches
        t = Split(x(z), vbCrLf)
        For i = 0 To UBound(t)
            tc = Split(Application.Trim(t(i)), " ")
            For a = 0 To UBound(tc)
                If tc(0) = "cent" Then tc(0) = 100
                If InStr(1, tc(a), "cent") = 0 Then
                    q = Application.IfError(Application.Match(tc(a), Lettres, 0), 0)
                    If q > 0 Then tc(a) = IIf(a > 0, "+", "") & chiffre(q - 1)
                Else
                    tc(a - 1) = Val(tc(a - 1)) * 100: tc(a) = ""
                End If
            Next
            t(i) = Join(tc)
            If InStr(1, t(i), "*") > 0 Then t(i) = "(" & Replace(t(i), "*", ")*")
            t(i) = "(" & t(i) & ")"
        Next
        StringOper = Replace((Replace(Replace(Join(t, "+"), "+()", ""), "()*", "")), " ", "")
        calcul = calcul + IIf(z = 1, Evaluate(StringOper) / 100, Evaluate(StringOper))
        'Debug.Print chaine & vbCrLf; "l'operation " & IIf(z = 0, "entier", "centime") & vbCrLf & StringOper & vbCrLf & "Résultat " & calcul
        StringOper = ""
    Next
    'Debug.Print "**********************************"
    If divi = 100 Then calcul = calcul / 100
    NblettreToNum = calcul
End Function
Non, octante n'existe pas en Belgique... on n'est pas si différent des Français tout compte fait :)

Merci,

Phil
 

phil66

XLDnaute Junior
re
@Phil69970 ben sur le net c'est un débat encore en vigueur d’après ce que j'ai lu
au pire la somme sera quand même interprétée ça mange pas de pain

je met ça au propre je réduit le code des array (j'ai ma petite idée sur la question )

purée vous m'en donnez du bouboul vous 😅😅
Non et mille fois non... octante n'est plus utilisé nulle part depuis des décennies (siècles), je te mets au défi de trouver un belge qui l'utilise ! Tant qu'à finaliser ton très bon boulot, autant qu'il soit correct jusqu'au bout. Ce n'est pas une critique, je reste admiratif de ton savoir :)

Phil
 

patricktoulon

XLDnaute Barbatruc
Bon ben voilà
je retire le besoins de l'argument region
la fonction marche avec un seul array pour FR,Belgique,Suisse
la même fonction, la même formule pour tout le monde
c'est comme ça que je pratique j'optionalyse et je réduit les flip flap entre array

purée j'aurais jamais cru aller aussi loin avec ce truc
merci @Yeahou et @Phil69970 d'avoir suggérer les 3 langues
l’exercice fut intéressant pendant 2 sec et demie pour la réduction à un seul array
je me demande pourquoi je n'y ai pas pensé plus tôt

la belgique a droit a octante ou quatre-vingt pour ceux qui ne sont pas d'accords avec Phil

démonstration (même fonction même formule )

demo.gif

VB:
'*************************************
'nombre lettre to nombre en numerique
'auteur :patricktoulon
'version1.2 17/06/2019
' en cours de developpements
'version finale 1.3 29/11/2021
'mise ajour
'ajout de la prise en charge des centimes 29/11/2021
' ajout de  de plusieur syntaxes autorisée
'ajout de la suisse et la belgique
'************************************
Option Explicit
Sub test()
    MsgBox NblettreToNum("sept-cent-trente-huit Euros et  dix-huit")
End Sub

Function NblettreToNum(chaine As String, Optional region As String = "fr")
    Dim Lettres, chiffre, tranche, tranchenum, x, z&, i&, a&, t, q&, tc, StringOper, calcul, divi&
        
    Lettres = Array("zero", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", _
                     "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "vingt", "trente", "quarante", "cinquante", _
                     "soixante", "soixante dix", "septante", "quatrevingt", "huitante", "octante", "quatrevingtdix", "nonante", "cent", "cents")
     chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 70, 80, 80, 80, 90, 90, 100, 100)
    
    
    tranche = Array("mille", "million", "milliard"): tranchenum = Array("*1000" & vbCrLf, "*1000000" & vbCrLf, "*1000000000" & vbCrLf)
    x = Application.Trim(LCase(chaine))
    'nettoyage grammatical FR
    For i = 4 To UBound(Lettres): x = Replace(x, Lettres(i) & "s", Lettres(i)): Next    'pour les "s" des nombres en lettres
    x = Replace(x, "€uro", "euro")
    If x Like "*centime*" And Not x Like "*euro*" Then divi = 100
    If x Like "*centime*" And x Like "*,*" Then divi = 1
    x = Replace(Replace(Replace(Replace(x, "euros", "euro"), "zéro", "zero"), "-", " "), "euro et", ",")
    If Right(x, 4) = "euro" Then x = Replace(x, "euro", "")
    If Mid(x, InStr(1, x, "euro") + 2) <> "" Then x = Replace(x, "euro", ",")
    x = Replace(Replace(Replace(Replace(Replace(Replace(x, "virgule", ","), "virgule", ","), " et ", " "), "d'", " "), "euro", ""), "€", "")
    x = Replace(Replace(Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt"), "centimes", ""), "centime", "")    'cas particulier de quatr vingt(s)
    For i = 0 To UBound(tranche): x = Replace(x, tranche(i), tranchenum(i)): Next
    x = Split(Application.Trim(x), ",")
    For z = 0 To UBound(x)
        'on a les tranches
        t = Split(x(z), vbCrLf)
        For i = 0 To UBound(t)
            tc = Split(Application.Trim(t(i)), " ")
            For a = 0 To UBound(tc)
                If tc(0) = "cent" Then tc(0) = 100
                If InStr(1, tc(a), "cent") = 0 Then
                    q = Application.IfError(Application.Match(tc(a), Lettres, 0), 0)
                    If q > 0 Then tc(a) = IIf(a > 0, "+", "") & chiffre(q - 1)
                Else
                    tc(a - 1) = Val(tc(a - 1)) * 100: tc(a) = ""
                End If
            Next
            t(i) = Join(tc)
            If InStr(1, t(i), "*") > 0 Then t(i) = "(" & Replace(t(i), "*", ")*")
            t(i) = "(" & t(i) & ")"
        Next
        StringOper = Replace((Replace(Replace(Join(t, "+"), "+()", ""), "()*", "")), " ", "")
        calcul = calcul + IIf(z = 1, Evaluate(StringOper) / 100, Evaluate(StringOper))
        'Debug.Print chaine & vbCrLf; "l'operation " & IIf(z = 0, "entier", "centime") & vbCrLf & StringOper & vbCrLf & "Résultat " & calcul
        StringOper = ""
    Next
    'Debug.Print "**********************************"
    If divi = 100 Then calcul = calcul / 100
    NblettreToNum = calcul
End Function
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
là oui @Yeahou elle mérite d’être dans le forum des fonctions
Re,

Juste une question, pourquoi un paramètre régional ?
et en remarque, on utilise aussi septante et nonante en Alsace.
Pour les devises, je ne sais pas si tu as intégré le franc :
en suisse le franc (Suisse)
en Polynésie française, Nouvelle Calédonie, Wallis et Futuna, le franc (Pacifique ou CFP en abrégé) qui reste une des deux monnaies françaises officielles avec l'Euro
et 14 pays francophones d'Afrique utilisent encore le franc (CFA)

Bien cordialement, @+
 

Discussions similaires

Statistiques des forums

Discussions
312 113
Messages
2 085 426
Membres
102 888
dernier inscrit
medoit