Convertir nombre en lettres

Plusieurs démo du même style sont disponibles mais d'après ce que je constate sont toutes, soit limitées, soit ne respecte pas fidèlement la syntaxe.

Cette démo transforme un nombre en lettres jusque 999 Billiard avec 2 décimales si une devise est sélectionnée, jusque 0.000000009 si pas de devise, idem en négatif.

Respecte toutes les règles de la syntaxe de la langue française. (Jusqu'à infirmation de votre part)

Sur les classeurs xls et xlsm, deux fonctions sont disponibles permettant une formule dans une feuille ou un appel de fonction dans un UserForm .

Pour les xla et xlax, seul la fonction de feuille est dispo, les appels ne sont pas possible à partir d'un UserForm.

Exemple dans une feuille Excel

1 2

Dans un Userform

3

Téléchargements

Classeur Excel 97 - 2003 :

Classeur Excel 2007 => :

1'217nombre-lettre-2007.xlsm (30.83 Ko)

Classeur Excel 97 - 2003, macro complémentaire (mode d'emploi inclus) :

Classeur Excel 2007 => , macro complémentaire (mode d'emploi inclus) :


LE CODE

Dans Module1

Option Explicit
Const Sep = ","
Public Pays As Byte
Dim Decim As String, Stade As Integer
Dim strResultat(6) As String
Dim Reste As Single
Dim StrReste As String
Dim Devize As String
Public Unite(19) As String
Public Monnaie(7) As String
Public Dixaines(2 To 9) As String
Dim ValNb(6) As Double
Dim mStrTemp As String

Function EnTexte(Chiffre As Range, Optional Langue As Byte = 0, Optional Devise As Byte = 0, Optional Decimale As Byte = 0) As String
    Application.Volatile
    EnTexte = LeTexte(Chiffre.Value, Langue, Devise, Decimale)
End Function

Function UFTexte(Chiffre As Double, Optional Langue As Byte = 0, Optional Devise As Byte = 0, Optional Decimale As Byte = 0) As String
    UFTexte = LeTexte(Chiffre, Langue, Devise, Decimale)
End Function

Function LeTexte(Chiffre As Double, Optional Langue As Byte = 0, Optional Devise As Byte = 0, Optional Decimale As Byte = 0) As String

Dim i As Integer, txt As String

Dim strTemp As String
Dim a As String, Nombre As String, TB, P As String
    Nombre = CStr(Abs(Chiffre))
    If Chiffre = 0 Then LeTexte = "": Exit Function
    If Nombre = 0 Then LeTexte = "Zéro": If Decimale = 0 Then Exit Function
    If Decimale = 0 Or Int(Chiffre) = Chiffre Then
        Nombre = RoundA(Nombre, 0)
        Reste = 0
        If Int(Chiffre) = 0 And Reste = 0 Then LeTexte = "Zéro": Exit Function
    Else
        TB = Split(CStr(Chiffre), Sep)
        Reste = TB(1) / 10 ^ Len(TB(1)) 'pour 2 décimales
        StrReste = TB(1) 'si pas de devise, met toutes les décimales
        If Chiffre = 0 Then
            strTemp = "Zéro "
            GoTo PasUnite
        End If
        Nombre = Int(Abs(Chiffre))
    End If
    Pays = Langue
    If Unite(1) = "" Then InitVar
    InitPays
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = "0" & Nombre
        GoTo reco
    End If
    Stade = (Len(Nombre) / 3)
    For i = 0 To Stade - 1
        txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(txt)
        strResultat(i) = Centaine(txt)
    Next i
    i = 0
    If Stade > 4 Then 'Billiard
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Billiard ", "Billiards ")
        End If
        i = i + 1
    End If
    If Stade > 3 Then 'Milliard
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Milliard ", "Milliards ")
        End If
        i = i + 1
    End If
    If Stade > 2 Then 'Million
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Million ", "Millions ")
        End If
        i = i + 1
    End If
    If Stade > 1 Then 'millier
        If strResultat(i) <> "" Then
            If strResultat(i) = "un " Then
                strTemp = strTemp & "Mille "
            Else
                strTemp = strTemp & VoirRegle(strResultat(i)) & "Mille "
            End If
        End If
        i = i + 1
    End If
    If Stade > 0 Then 'les unités
        If strResultat(i) <> "" Then
            If strTemp <> "" And ValNb(i) < 100 And (Right(strResultat(i), 3) <> "un " Or Len(strResultat(i)) = 3) Then
            TB = Split(strTemp, " ")

            Select Case TB(UBound(TB) - 1)
            Case "Million", "Millions", "Milliard", "Milliards", "Billiard", "Billiards"
                strTemp = strTemp & "et "
            End Select
            End If
            strTemp = strTemp & VoirRegle(strResultat(i), False)
        End If
    End If
    TB = Split(strTemp, " ")
    Select Case TB(UBound(TB) - 1)
    Case "Million", "Millions", "Milliard", "Milliards", "Billiard", "Billiards"
        Select Case Devise
        Case 1, 3: strTemp = strTemp & "de "
        Case 2: strTemp = strTemp & "d'"
        End Select
    End Select
PasUnite:
    Select Case Devise
    Case Is > 0: strTemp = strTemp & Monnaie(Devise) & IIf(Nombre = 1, " ", "s ")
    End Select
    If Reste <> 0 And Decimale = 1 Then
        If Devise = 0 Then
            strTemp = strTemp & "Virgule "
            'Appel pour les décimales en base 3
            strTemp = strTemp & AprVirgule(StrReste)
        Else:
            strTemp = strTemp & " " & P
            Reste = Int(Reste * 1000) / 10
            ValNb(1) = RoundA(Reste, 0)
            If ValNb(1) = 100 Then 'rectifie 100 centimes
                strTemp = LeTexte(RoundA(Chiffre, 0), Pays, Devise, 0)
            Else
                txt = Right("00" & Trim(Str(ValNb(1))), 3)
                txt = Centaine(txt): txt = Trim(txt) & " "
                strTemp = strTemp & VoirRegle(txt)
                strTemp = strTemp & Monnaie(Devise + 4) & IIf(ValNb(1) = 1, "", "s")
            End If
        End If
    End If
    If Chiffre < 0 Then strTemp = "Moins " & strTemp
    LeTexte = strTemp
End Function

Private Function AprVirgule(Nombre As String) As String
Dim i As Integer, txt As String, strTemp As String, N
    N = Array("Millième", "Millionnième", "Milliardième")
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = Nombre & "0"
        GoTo reco
    End If
    Stade = (Len(Nombre) / 3)
    If Stade > 3 Then Stade = 3
    For i = 0 To Stade - 1
        txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(txt)
        strResultat(i) = Centaine(txt)
    Next i
    For i = 0 To Stade - 1
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & N(i) & IIf(ValNb(i) > 1, "s ", " ")
        End If
    Next i
    AprVirgule = strTemp
End Function

Private Function Centaine(Nombre As String) As String
Dim i As Integer, e(3) As Integer, a As String
Dim strBuff As String
    For i = 3 To 1 Step -1
        e(i) = Val(Mid(Nombre, i, 1))
    Next i
    e(0) = Val(Right(Nombre, 2))

    If e(3) = 1 Then
        If Pays = 0 Then
            If e(2) <= 7 Then strBuff = "et un " Else strBuff = Unite(e(3))
        Else
            If e(2) <> 8 Then strBuff = "et un " Else strBuff = Unite(e(3))
        End If
    Else
        strBuff = Unite(e(3))
    End If
    If e(0) < 20 Then
        strBuff = Unite(e(0))
    ElseIf e(0) < 70 Or (e(0) > 79 And e(0) < 90) Or Pays <> 0 Then
        If e(3) > 0 And Left(strBuff, 2) <> "et" Then
            strBuff = Trim(Dixaines(e(2))) & "-" & LTrim(strBuff)
        ElseIf strBuff <> "" Then
            strBuff = Dixaines(e(2)) & strBuff
        Else
            strBuff = Dixaines(e(2))
        End If
    Else
        If e(0) > 89 Then i = 80 Else i = 60
        If e(3) = 1 And e(2) = 7 Then
            strBuff = RTrim(Dixaines(e(2) - 1)) & " " & "et onze "
        Else
            strBuff = RTrim(Dixaines(e(2) - 1)) & "-" & Unite(e(0) - i)
        End If
    End If

    'Centaine
    If e(1) = 1 Then
        strBuff = "cent " & strBuff
    ElseIf e(1) >= 1 Then
        strBuff = Unite(e(1)) & "cent " & strBuff
    End If
    Centaine = strBuff
End Function

Public Function RoundA(ByVal Nombre, ByVal Decimales)
      RoundA = Int(Nombre * 10 ^ Decimales + 1 / 2) / 10 ^ Decimales
End Function

Private Function VoirRegle(V As String, Optional Stde As Boolean = True) As String
        If Right(V, 6) = "vingt " Then
            If Stde Then
                VoirRegle = V
            ElseIf Len(V) > 6 Then
                VoirRegle = RTrim(V) & "s "
            Else
                VoirRegle = V
            End If
        ElseIf Right(V, 4) = "ent " Then
            If Stde Then
                VoirRegle = V
            ElseIf Len(V) > 5 Then
                VoirRegle = RTrim(V) & "s "
            Else
                VoirRegle = V
            End If
        Else
            VoirRegle = V
        End If
End Function

Dans Module2

Public Sub InitVar()
Unite(0) = "":          Unite(1) = "un ":       Unite(2) = "deux ":     Unite(3) = "trois ":    Unite(4) = "quatre "
Unite(5) = "cinq ":     Unite(6) = "six ":      Unite(7) = "sept ":     Unite(8) = "huit ":     Unite(9) = "neuf "
Unite(10) = "dix ":     Unite(11) = "onze ":    Unite(12) = "douze ":   Unite(13) = "treize ":  Unite(14) = "quatorze "
Unite(15) = "quinze ":  Unite(16) = "seize ":   Unite(17) = "dix-sept ": Unite(18) = "dix-huit ": Unite(19) = "dix-neuf "

Dixaines(2) = "vingt ": Dixaines(3) = "trente ": Dixaines(4) = "quarante ": Dixaines(5) = "cinquante ": Dixaines(6) = "soixante "

Monnaie(0) = "": Monnaie(1) = "Dollar": Monnaie(2) = "Euro": Monnaie(3) = "Franc"
Monnaie(4) = "": Monnaie(5) = "Cent": Monnaie(6) = "Centime": Monnaie(7) = "Centime"
End Sub

Sub InitPays()
    Select Case Pays
    Case 0 'France
        Dixaines(7) = "soixante-dix "
        Dixaines(8) = "quatre-vingt "
        Dixaines(9) = "quatre-vingt-dix "
    Case 1 'Belge
        Dixaines(7) = "septante "
        Dixaines(8) = "quatre-vingt "
        Dixaines(9) = "nonante "
    Case 2 'suisse
        Dixaines(7) = "septante "
        Dixaines(8) = "huitante "
        Dixaines(9) = "nonante "
    End Select
End Sub

Bonjour,

Je me permets de poster afin d'indiquer que cette méthode fonctionne également pour excel 2010.

Merci, ça faisait des jours que je me cassais la tête sur ça, votre forum n’étant pas en haut de la liste sur mes recherches google (et c'est bien dommage) je ne l'ai pas vu de suite.

Bonne continuation.

Bonjour ,

Merci pour la précision.

Cdlt.

Lermite

Salut Lermite,

A première vue ton outil a l'air assez génial. Mais pourquoi les dénominations (Millions, Mille, Virgules, etc.) sont elles écrites en majuscules ?

A te relire.

Bonjour Yvouille,

La mise au point a été relativement difficile pour répondre le plus exactement possible aux descriptions de la langue française (beaucoup de recherche), les majuscules sur les unités en font partie et de plus cela permet une meilleur lisibilité.

A+

Bonjour Lermite

Tout d'abord Excel - lent travail pour cette macro convertir nombre en lettre.

Je voudrais apporter une modification aux codes.

Pour les "milles" la syntaxe et la meme que pour les centaines.

Avoir

200 = deux cents

201 = deux cent un

Il en est de meme pour les milliers.

2000 = Deux Milles

2001 = Deux mille un.

je ne parviens pas a effectuer cette modif.

pourriez vous me donner un coup de mains.

Merci

Bonjour,

Mille est invariable suivant les critères de la langue française.

EDIT :

Historiquement, mille était le pluriel de mil, ce qui explique pourquoi mille est invariable. L'écriture mil n'est possible que pour des dates, et elle n'est nullement obligatoire. Comme l'écrit Dominique Didier, la distinction entre les deux graphies est parfaitement oiseuse si on veut encore la pratiquer aujourd'hui (source :

)

Voir écriture des nombres sur ce site qui m'a bien guider pour finaliser cette appli.

Et si t'est pas d'accord... j'en ai d'autre.

Conclusion -> Se documenté AVANT

A+

EDIT 2:

Tout d'abord Excel - lent travail pour cette macro convertir nombre en lettre.

Personne ne t'oblige à employer Excel, si tu veux je peu te donner les Url pour le même programme en VB.Net ou en VB6

Tu n'a qu'a dire.

Tout d'abord Mea Culpa , maxi Mea Culpa

je viens de réaliser que j'ai toujours mal ecrit mas chiffre.

Je me coucherai moins betes ce soir.

GUTZ78 a écrit :

Je me coucherai moins betes ce soir.

Mais non, mais non.. faut être positif ->> Plus malin ce soir.

salut, comment je peux modifier dans un macro par exemple euro en dirhams et millième en centime merci

Bonjour,

Pour ta première question, dans la partie du module 2 tu trouve..

Monnaie(0) = "": Monnaie(1) = "Dollar": Monnaie(2) = "Euro": Monnaie(3) = "Franc"
Monnaie(4) = "": Monnaie(5) = "Cent": Monnaie(6) = "Centime": Monnaie(7) = "Centime"

Simplement remplacer "Euro" par "dirhams".

Pour la deuxième, remplacer millième par centime je ne comprend pas ce que tu veux, donne un exemple.

Tu te sert de la fonction sur une feuille ou un UserForm ?

A+

Bonjour lermite,

Tout d'abord, très beau boulot.

Je viens de tester classeur Excel 2007 => : Nombre en lettres.xlsm sous Excel 2013 et il fonctionne parfaitement.

Bonjour Fred,

Merci de ton appréciation.

Cdlt.

Bonjour,

Je cherchais comment faire depuis un bon moment, alors merci beaucoup pour cette macro.

Juste un petit soucis :

Je voudrait remplacer les francs (ou autre) par CFP, et quand je veux ouvrir VBA Project (Nombre Lettre 2007.xlam), il me demande un mot de passe.

Quelle est-il SVP ?

Merci d'avance,

LeZor.

Bonjour,

Télécharge le classeur xlsm, sur celui-là tu peu avoir accès au code. Après modification tu le sauve en Xlam.

A+

Merci pour la réponse (et pour le reste, c'est vraiment top comme macro !!)

merci pour votre reponse, j'avais finalement trouver mon bonheur, avec quelques modifications pour l'adapter à mon pays (nouvelle caledonie), ca marche parfaitement.

A bientôt et bonne journée,

Olivier.

Bonsoir,

superbe travail, excellente fonction!

Je souhaiterais integrer cette fonction dans un formulaire word, de manière à remplir un champ de texte automatiquement apres avoir rempli le champ avec le nombre. Comment m'y prendre pour adapter cela?

Merci pour votre aide

A bientot

Lionel

Bonsoir,

Sauf erreur de ma part votre module est incorrect pour 3 cas :

  • un chiffre avec uniquement des décimales exemple : 0,19 €, vous obtenez "#VALEUR!"
  • dans le cas d'une monnaie et dont le montant est par exemple 1,005 € (ce résultat peut être dû à des calculs par exemple), vous obtenez "un euro et centimes"
  • dans le cas d'une monnaie et dont le montant est (par calcul) -0,005 $...

Cordialement

Rechercher des sujets similaires à "convertir nombre lettres"