VBA pour convertir un nombre en lettres

Le 09/01/2025 à 20:21

Bonjour,

J'espère que vous allez bien. Je sollicite votre aide pour identifier l'erreur dans ma formule VBA.

Mon objectif est de convertir des nombres en lettres dans un fichier Excel.

Le nombre à convertir est $2274.40. Le résultat obtenu est deux mille deux cent soixante-dix-quatre et quarante sous!

image

Voici la formule utilisée:

Function NombreEnLettres(ByVal Montant As Double) As String
    Dim entiers As Long
    Dim decimaux As Long
    Dim resultat As String

    entiers = Int(Montant)
    decimaux = Round((Montant - entiers) * 100, 0)

    If entiers = 0 Then
        resultat = "zéro"
    Else
        resultat = ConvertirPartie(entiers)
    End If

    If decimaux > 0 Then
        ' Ajustement pour ne pas dire "sous" si le montant est 1 centime
        If decimaux = 1 Then
            resultat = resultat & " et un sous"
        Else
            resultat = resultat & " et " & ConvertirPartie(decimaux) & " sous"
        End If
    End If

    NombreEnLettres = resultat
End Function

Private Function ConvertirPartie(ByVal Nombre As Long) As String
    Dim unitesTab As Variant
    Dim dizainesTab As Variant
    Dim result As String
    Dim centaines As Long
    Dim milliers As Long

    unitesTab = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
    dizainesTab = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingts", "quatre-vingt-dix")

    If Nombre < 100 Then
        result = ConvertirUniteDizaine(Nombre, unitesTab, dizainesTab)
    ElseIf Nombre < 1000 Then
        centaines = Int(Nombre / 100)
        If centaines > 1 Then
            result = unitesTab(centaines) & " cent "
        ElseIf centaines = 1 Then
            result = "cent "
        End If
        Nombre = Nombre Mod 100
        If Nombre > 0 Then result = result & ConvertirUniteDizaine(Nombre, unitesTab, dizainesTab)
    Else
        milliers = Int(Nombre / 1000)
        result = unitesTab(milliers) & " mille "
        Nombre = Nombre Mod 1000
        If Nombre > 0 Then result = result & ConvertirPartie(Nombre)
    End If

    ConvertirPartie = Trim(result)
End Function

Private Function ConvertirUniteDizaine(ByVal Nombre As Long, ByVal unitesTab As Variant, ByVal dizainesTab As Variant) As String
    Dim unite As Long
    Dim dizaine As Long
    Dim result As String
    unite = Nombre Mod 10
    dizaine = Int(Nombre / 10)

    If dizaine = 0 Then
        result = unitesTab(unite)
    ElseIf dizaine = 1 Then
        If unite = 0 Then
            result = "dix"
        ElseIf unite = 1 Then
            result = "onze"
        ElseIf unite = 2 Then
            result = "douze"
        ElseIf unite = 3 Then
            result = "treize"
        ElseIf unite = 4 Then
            result = "quatorze"
        ElseIf unite = 5 Then
            result = "quinze"
        ElseIf unite = 6 Then
            result = "seize"
        Else
            result = "dix-" & unitesTab(unite)
        End If
    ElseIf dizaine = 7 Or dizaine = 9 Then
        result = dizainesTab(dizaine) & "-" & unitesTab(unite)
    Else
        result = dizainesTab(dizaine) & " " & unitesTab(unite)
    End If

    ConvertirUniteDizaine = Trim(result)
End Function

Je vous remercie d'avance pour l'attention que vous porterez à ma demande.

Bonne journée et à bientôt

Catherine

Le 09/01/2025 à 21:01

Bonnjour,

n'aant aucune solution à te proposer, j'ai cherché sur le Net et ai trouvé ceci :

image

est ce que cela te convient ?

Bonne soirée

Le 09/01/2025 à 21:08

Je vais me faire jeter mais, essayons !

Tu peux remplacer "soixante-dix" par SEPTANTE et "qua... bon, je sors!

Le 09/01/2025 à 21:20

Bonsoir,

plusieurs fonctions qui permettent de faire ce que vous chercher, avec un arrondi à deux décimales et peut aller jusqu'à 999999999999999 sans décimale et 9999999999999.99 avec décimale !
Les différents code à copier dans un module standard :

Option Explicit

Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 0, _
Optional Langue As Byte = 0, _
Optional Casse As Byte = 0, _
Optional ZeroCent As Byte = 0) As String

    Dim dblEnt As Variant, byDec As Byte
    Dim bNegatif As Boolean
    Dim strDev As String, strCentimes As String
    If Nombre < 0 Then
        bNegatif = True
        Nombre = Abs(Nombre)
    End If
    dblEnt = Int(Nombre)
    byDec = CInt((Nombre - dblEnt) * 100)
    If byDec = 0 Then
        If dblEnt > 999999999999999# Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    Else
        If dblEnt > 9999999999999.99 Then
        ConvNumberLetter = "#TropGrand"
        Exit Function
        End If
    End If
    Select Case Devise
        Case 0
            If byDec > 0 Then strDev = " virgule "
        Case 1
            strDev = " Euro"
            If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'Euro"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " Dollar"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
        Case 3
            strDev = " €uro"
            If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'€uro"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
            If byDec > 1 Then strCentimes = strCentimes & "s"
    End Select
    If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
    strDev = strDev & " "
    If dblEnt = 0 Then
        ConvNumberLetter = "zéro " & strDev
    Else
        ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
    End If
    If byDec = 0 Then
        If Devise <> 0 Then
            If ZeroCent = 1 Then ConvNumberLetter = ConvNumberLetter & "zéro Cent"
        End If
    Else
        If Devise = 0 Then
            ConvNumberLetter = ConvNumberLetter & _
            ConvNumDizaine(byDec, Langue, True) & strCentimes
        Else
            ConvNumberLetter = ConvNumberLetter & _
            ConvNumDizaine(byDec, Langue, False) & strCentimes
        End If
    End If
    ConvNumberLetter = Replace(ConvNumberLetter, " ", " ")
    If Left(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
    Right(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    If Right(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
    Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    Select Case Casse
        Case 0
            ConvNumberLetter = IIf(bNegatif, "Moins ", "") & LCase(ConvNumberLetter)
        Case 1
            ConvNumberLetter = IIf(bNegatif, "Moins ", "") & UCase(Left(ConvNumberLetter, 1)) & _
            LCase(Right(ConvNumberLetter, Len(ConvNumberLetter) - 1))
        Case 2
            ConvNumberLetter = IIf(bNegatif, "Moins ", "") & UCase(ConvNumberLetter)
        Case 3
            ConvNumberLetter = IIf(bNegatif, "Moins ", "") & Application.WorksheetFunction.Proper(ConvNumberLetter)
            If Devise = 3 Then _
            ConvNumberLetter = Replace(ConvNumberLetter, "€Uros", "€uros", , , vbTextCompare)
    End Select
End Function

Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Integer, iMille As Integer, iMillion As Integer
Dim iMilliard As Integer, iBillion As Integer

iTmp = Nombre - (Int(Nombre / 1000) * 1000)
iCent = CInt(iTmp)
ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
dblReste = Int(Nombre / 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMille = CInt(iTmp)
strTmp = ConvNumCent(iMille, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = " mille "
Case Else
strTmp = strTmp & " mille "
End Select
If iMille = 0 And iCent > 0 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMillion = CInt(iTmp)
strTmp = ConvNumCent(iMillion, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " million "
Case Else
strTmp = strTmp & " millions "
End Select
If iMille = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMilliard = CInt(iTmp)
strTmp = ConvNumCent(iMilliard, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " milliard "
Case Else
strTmp = strTmp & " milliards "
End Select
If iMillion = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iBillion = CInt(iTmp)
strTmp = ConvNumCent(iBillion, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " billion "
Case Else
strTmp = strTmp & " billions "
End Select
If iMilliard = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function

Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Byte, byDiz As Byte
Dim strLiaison As String

If bDec Then
TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
Else
TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
End If
If Nombre = 0 Then
TabUnit = Array("zéro")
Else
TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
End If
If Langue = 1 Then
TabDiz(7) = "septante"
TabDiz(9) = "nonante"
ElseIf Langue = 2 Then
TabDiz(7) = "septante"
TabDiz(8) = "huitante"
TabDiz(9) = "nonante"
End If
byDiz = Int(Nombre / 10)
byUnit = Nombre - (byDiz * 10)
strLiaison = "-"
If byUnit = 1 Then strLiaison = " et "
Select Case byDiz
Case 0
strLiaison = " "
Case 1
byUnit = byUnit + 10
strLiaison = ""
Case 7
If Langue = 0 Then byUnit = byUnit + 10
Case 8
If Langue <> 2 Then strLiaison = "-"
Case 9
If Langue = 0 Then
byUnit = byUnit + 10
strLiaison = "-"
End If
End Select
ConvNumDizaine = TabDiz(byDiz)
If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
If TabUnit(byUnit) <> "" Then
ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
Else
ConvNumDizaine = ConvNumDizaine
End If
End Function

Private Function ConvNumCent(Nombre As Integer, Langue As Byte) As String
Dim TabUnit As Variant
Dim byCent As Byte, byReste As Byte
Dim strReste As String

TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix")
byCent = Int(Nombre / 100)
byReste = Nombre - (byCent * 100)
strReste = ConvNumDizaine(byReste, Langue, False)
Select Case byCent
Case 0
ConvNumCent = strReste
Case 1
If byReste = 0 Then
ConvNumCent = "cent"
Else
ConvNumCent = "cent " & strReste
End If
Case Else
If byReste = 0 Then
ConvNumCent = TabUnit(byCent) & " cents"
Else
ConvNumCent = TabUnit(byCent) & " cent " & strReste
End If
End Select
End Function
Private Function Nz(strNb As String) As String
If strNb <> " zéro" Then Nz = strNb
End Function

Exemple de formule si la valeur à traduire est en A1 : =ConvNumberLetter(A1)

Note : les codes ne sont pas de moi !

Et avec ceci : Application.Speech.Speak ActiveSheet.Range("B1").Value, True, Excel le lit !

@ bientôt

LouReeD

Le 09/01/2025 à 21:31

Merci beaucoup pour vos réponses et votre aide

Bonne soirée à tous!

Le 10/01/2025 à 14:03

Salut Catherine,
Salut Jacky, LouReed,

un petit code pour faire le boulot jusqu'à un poil du billiard !
Cela dit, même Elon Musk n'a jamais compté jusque là!

Celui qui peut trouver la faille qui empêche le code d'aller jusqu'au quadrilliard aura toute ma reconnaissance excelienne!
Probablement encore à peaufiner!
- accepte les "." et "," comme délimiteurs de décimales en écriture française.
- on peut renseigner la monnaie principale (dollar, €uro...) et les centimes (cent, centime, ...) au singulier.
- convertit jusque 999.999.999.999.999, à la porte du billiard, au-delà duquel ma variable texte qui contient le nombre passe en notation scientifique et fait capoter le code.

    For x = 1 To iDec
        sM1 = sM                                                                'sM1 = variable intermédiaire
        If InStr(sM, ".") > 0 Then sM1 = Split(sM, ".")(x - 1)                  'x = 1 : partie entière du nombre
        If InStr(sM, ",") > 0 Then sM1 = Split(sM, ",")(x - 1)
        If x = 2 Then                                                           'x = 2 : partie décimale réduite à 2 chiffres
            If Len(sM1) > 2 Then sM1 = Left(sM1, 2)
            sM1 = IIf(Len(sM1) = 1, "0" & sM1 & "0", "0" & sM1)
        End If
        'Principe du calcul : je saucissonne sM en blocs de 3 caractères avec ajout de "0" en tête de variable pour compléter le bloc
        If Len(sM1) Mod 3 > 0 Then sM1 = IIf(Len(sM1) Mod 3 = 1, "00", "0") & sM1
        For y = Len(sM1) To 1 Step -3                                           'on débute par la droite du nombre
            iIdx = 0                                                            '3 caractères par bloc
            sRep = ""                                                           'RAZ variable résultat de l'étape
            iStep = iStep + 1                                                   'compte l'enchaînement des blocs traités
            iNum1 = IIf(CInt(Mid(sM1, y, 1)) = 0, 10, CInt(Mid(sM1, y, 1)))     'mise en mémoire de la valeur du caractère de droite
            For Z = y To y - 2 Step -1                                          'on parcourt le bloc de 3 caractères de droite à gauche
                iIdx = iIdx + 1
                iNum = CInt(Mid(sM1, Z, 1))                                     'conversion en chiffres du caractère en cours
                Select Case iIdx
                    Case 1
                        If iNum > 0 Then sRep = tU(iNum - 1)                    'unités
                    Case 2
                        If iNum > 0 Then
                            If iNum = 1 Then sRep = IIf(iNum1 = 0, tD1(9), tD1(iNum1 - 1))              'si dizaine = 1 -> onze, douze... selon iNum1
                            If iNum = 7 Then sRep = "soixante-" & IIf(iNum1 = 0, tD1(9), tD1(iNum1 - 1)) 'si dizaine = 7 -> soixante-onze,... selon iNum1
                            If iNum = 9 Then sRep = "quatre-vingt-" & IIf(iNum1 = 0, tD1(9), tD1(iNum1 - 1)) 'si dizaine 9 -> quatre-vingt... selon iNum1
                            'autres cas avec la particularité du "-" de la vingtaine ou du "et un"
                            If iNum <> 1 And iNum <> 7 And iNum <> 9 Then sRep = tD2(iNum - 1) & _
                                IIf(iNum1 = 10, "", IIf(iNum = 2 And iNum1 <> 1, "-", " ") & IIf(iNum >= 2 And iNum1 > 1, "", "et ")) & sRep
                        End If
                    Case 3                      'uniquement pour la partie entière : cap de la centaine du bloc avec "s" ou pas
                        If x = 1 Then _
                            If iNum > 0 Then _
                                sRep = IIf(iNum = 1, "cent", tU(iNum - 1) & " cent" & IIf(iStep = 1 And sRep = "", "s", "")) & IIf(sRep = "", "", " " & sRep)
                End Select
            Next
            'compilation des étapes de la partie entière
            If x = 1 And sRep <> "" Then sCSTR = _
                IIf(iStep = 1, sRep, _
                IIf(iStep = 2 And sRep = "un", tM(iStep - 1), sRep & " " & tM(iStep - 1)) & _
                    IIf(iStep > 2 And sRep <> "un", "s", "")) & IIf(sCSTR = "", "", " ") & _
                    sCSTR
        Next
        'compilation des décimales
        If x = 1 Then sCSTR = sCSTR & " " & [MONNAIE] & IIf([MONNAIE] = "", "", IIf(sCSTR = "un", "", "s"))
        If x = 2 And sRep <> "" Then _
            sCSTR = sCSTR & " et " & sRep & " " & IIf([CENTIMES] = "", "centième", [CENTIMES]) & IIf(sRep = "un", "", "s")
    Next

A+

72cstr-num.xlsm (26.30 Ko)
Le 10/01/2025 à 18:36

Bondoir,

Et les nonante ?

La fonction fournie permet de choisir la "langue"

Beau travail !

@ bientôt

LouReeD

Le 10/01/2025 à 19:00

Salut LouReed,

la langue? Pour une version belge, alors! Quoi de mieux?

D'abord essayer de trouver la faille de VBA ou d'Excel ou de mon code car j'ai le même problème que l'auteur du code que tu as posté!

Si tu as une idée, n'hésite pas!

A+

Le 10/01/2025 à 22:03

Bonsoir,

Ici peut-être... en passant par l'assemblage de données "Texte".
Morceaux du nombre sur 4 colonnes de A1 à D1, puis en E1, cellule en format texte : =CONCAT(A1:D1)
Donc en imaginant une colonne par groupe de 3 unités vous pouvez alors aller au de là de 5 colonnes..., le CONCAT sera un string sans modification.
Ou bien partir d'un TextBox...

53quadrillion.xlsx (14.25 Ko)

@ bientôt

LouReeD

Rechercher des sujets similaires à "vba convertir nombre lettres"