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

Compte Supprimé 979

Guest
Salut Lionel,

C'est ballot 🤣

C'est dans cette fonction, il y avait 1005 au lieu de 1000 🤔
VB:
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 / 1000) * 1000
      NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
      no_Classe = no_Classe + 1
      Entier = Int(Entier / 1000)
    Wend
  End If
End Function

A+
 

patricktoulon

XLDnaute Barbatruc
si je me souvient bien j'avais repris ma fonction nblettreFR2020 et j'avais inversé le procc

pour commencer
il faut remplacer mille,millio,,milliard,etc... par un separateur de ton choix
on a donc les tranches
ensuite avec un array en lettres et le même en numérique remplacer dans la chaîne lettre par son homologue en numérique

quelques arrangement du genre si "cent" dedans alors le mot 1 de la trance = son homoloque en chiffre *cent
bref
faudrait que je la termine c'est amusant ce truc avec les contrainte grammaticale francaise
c'est plus simple en anglais
il suffit de joindre toute les tranches converties en numérique ensuite les unité mille,million,etc. étant implicite en numérique
LOL

exemple
deux-cents-trois mille quatre-cents-vingt-huit euros
on remplace les tirets par un espace
deux cents trois mille quatre cents vingt huit euros
maintenant on remplace les unités de tranche par un séparateur (celui que l'on veut)
deux-cents-trois / quatre-cents-vingt-huit

les bases array(on reprend ceux de ma fonction )
VB:
Lettres = Array("", "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", "quatre vingt", "quatre vingt dix", "cent")
    tranche = Array("mille", "million", "milliard")
    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, 90, "*100", "*1000|", "*1000000|", "*1000000000|", "*1000|", "*1000000|", "*1000000000|")
a la fin on format toute les tranches a trois chiffre pour les nombre <99 par tranche
élémentaire mon cher watson;)😅
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Salut Lionel,

C'est ballot 🤣

C'est dans cette fonction, il y avait 1005 au lieu de 1000 🤔
VB:
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 / 1000) * 1000
      NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
      no_Classe = no_Classe + 1
      Entier = Int(Entier / 1000)
    Wend
  End If
End Function

A+
Bonjour et Merci Bruno , oui c'est ballot lol j'aurais du le voir :)
 

patricktoulon

XLDnaute Barbatruc
tiens j'ai retrouver l'eprouvette que je n'vais pas fini il faut encore corriger la syntaxe de l’opération écrite avant évaluation
je regarderais ce soir en rentrant du bouboul
c'est vrai je ne l'ai jamais terminé ce truc (la flemme )
VB:
'*************************************
'nombre lettre to nombre en numerique
'auteur :patricktoulon
'version1.2 17/06/2019
' en cours de developpements
'************************************
Sub test()
    NblettreToNum "deux-cents-trois mille quatre-cents-vingt-huit euros"
    NblettreToNum "un million d'euros"
    NblettreToNum "un million cinq cents mille euros"
    NblettreToNum "cinq cents quatre vingts"
End Sub

Function NblettreToNum(chaine)
    x = LCase(chaine)
    lettres = Array("", "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", "quatrevingtdix", "cent", "cents")
    tranche = Array("mille", "million", "milliard")
    tranchenum = Array("*1000" & vbCrLf, "*1000000" & vbCrLf, "*1000000000" & vbCrLf)

    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, 90, 100, 100)

    'nettoyage grammatical FR
    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "euros", ""), "euro", "")
    x = Replace(x, "-", " ")
    x = Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt")
    For i = 0 To UBound(tranche): x = Replace(x, tranche(i), tranchenum(i)): Next
    x = Trim(x)
    'on a les tranches
    t = Split(x, vbCrLf)
    For i = 0 To UBound(t)
        tc = Split(t(i), " ")
        For a = 0 To UBound(tc)
            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) = Replace("(" & Replace("+(" & Join(tc) & ")", "*", ")*"), "(+", "+(")
    Next
    finalstring = Replace("0" & Replace(Join(t), " ", ""), "+()", "")
    MsgBox finalstring


End Function
 

patricktoulon

XLDnaute Barbatruc
re
bon ben j'ai simplifié
20 bonnes minutes pour tester dans tout les sens et ça roule ma boule
regardez dans le debug comment ça se passe ;) en débloquant la ligne
je comprends pas pourquoi je l'avais jamais fini ce truc 😂
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
'************************************
Sub test()
    MsgBox NblettreToNum("deux-cents-trois mille quatre-cents-vingt-huit euros")
    MsgBox NblettreToNum("un million d'euros")
    MsgBox NblettreToNum("un million cinq cents mille euros")
    MsgBox NblettreToNum("cinq cents quatre vingts")
    MsgBox NblettreToNum("deux cents soixante dix neuf")
    MsgBox NblettreToNum("mille quatre vingt dix")
End Sub

Function NblettreToNum(chaine As String)
    x = Application.Trim(LCase(chaine))
    lettres = Array("", "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", "quatrevingtdix", "cent", "cents")
    tranche = Array("mille", "million", "milliard")
    tranchenum = Array("*1000" & vbCrLf, "*1000000" & vbCrLf, "*1000000000" & vbCrLf)

    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, 90, 100, 100)

    'nettoyage grammatical FR
    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "euros", ""), "euro", "")
    x = Replace(x, "-", " ")
    x = Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt")
    For i = 0 To UBound(tranche): x = Replace(x, tranche(i), tranchenum(i)): Next
    x = Trim(x)
    'on a les tranches
    t = Split(x, 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(a) = 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
    finalstring = Replace(Replace(Join(t, "+"), "+()", ""), "()*", "")
    calcul = Evaluate(finalstring)
    'Debug.Print "l'operation " & vbCrLf & finalstring & vbCrLf & "Résultat " & calcul
    NblettreToNum = calcul
End Function

et voilà
diabolo.gif

demo.gif
 

patricktoulon

XLDnaute Barbatruc
allez on prends les même et on recommence les voila tes pièce rouge
la voilà finalisée avec les centimes
si dans la chaine il y blablabla euros et blablabla le calcul centime sera déclenché sinon non

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
'************************************
Option Explicit
Sub test()
    MsgBox NblettreToNum("deux-cents-trois mille quatre-cents-vingt-huit euros et vingt-quatre centimes")
End Sub

Function NblettreToNum(chaine As String)
    Dim Lettres, chiffre, tranche, tranchenum, x, z&, i&, a&, t, q&, tc, StringOper, calcul
    Lettres = Array("", "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", "quatrevingtdix", "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, 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
    x = Replace(Replace(x, "euros et", ","), "euro et", ",")
    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "euros", ""), "euro", "")
    x = Replace(x, "-", " ")
    x = Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt")
    x = Replace(Replace(x, "centimes", ""), "centime", "")
    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(a) = 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(Join(t, "+"), "+()", ""), "()*", "")
        calcul = calcul + IIf(z = 1, Evaluate(StringOper) / 100, Evaluate(StringOper))
        Debug.Print "l'operation " & IIf(z = 0, "entier", "centime") & vbCrLf & StringOper & vbCrLf & "Résultat " & calcul
        StringOper = ""
    Next
    NblettreToNum = calcul
End Function
voilà comme ça je l'aurais fini ce truc rigolo
démo
demo.gif
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87