Convertir nombre en lettres

Pour écrire et partager des tutoriels et des astuces (Excel, Calc et Google Sheets uniquement)
Avatar du membre
lermite
Membre impliqué
Membre impliqué
Messages : 1'599
Inscrit le : 5 février 2012
Version d'Excel : 2000/2007FR

Message par lermite » 23 février 2012, 15:42

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
Image
Image
Dans un Userform
Image

Téléchargements
Classeur Excel 97 - 2003 :Nombre en lettres.xls
Classeur Excel 2007 => : Nombre en lettres.xlsm
Classeur Excel 97 - 2003, macro complémentaire (mode d'emploi inclus) : Macro complementaire97-2003.zip
Classeur Excel 2007 => , macro complémentaire (mode d'emploi inclus) :Macro complementaire 2007.zip

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
Modifié en dernier par lermite le 4 novembre 2012, 08:20, modifié 1 fois.
Tout problème a une solution, le vrai problème... c'est de la trouver.
S
Shayanne
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 21 juin 2012
Version d'Excel : 2010

Message par Shayanne » 21 juin 2012, 01:34

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.
Avatar du membre
lermite
Membre impliqué
Membre impliqué
Messages : 1'599
Inscrit le : 5 février 2012
Version d'Excel : 2000/2007FR

Message par lermite » 21 juin 2012, 01:46

Bonjour , :bv3:
Merci pour la précision.
Cdlt.
Lermite
Tout problème a une solution, le vrai problème... c'est de la trouver.
Avatar du membre
Yvouille
Passionné d'Excel
Passionné d'Excel
Messages : 8'697
Appréciations reçues : 48
Inscrit le : 6 avril 2007
Version d'Excel : 2010

Message par Yvouille » 9 février 2013, 09:43

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.
Yvouille


:btres:
Avatar du membre
lermite
Membre impliqué
Membre impliqué
Messages : 1'599
Inscrit le : 5 février 2012
Version d'Excel : 2000/2007FR

Message par lermite » 9 février 2013, 09:51

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+
Tout problème a une solution, le vrai problème... c'est de la trouver.
G
GUTZ78
Nouveau venu
Nouveau venu
Messages : 4
Inscrit le : 12 février 2013
Version d'Excel : 2007

Message par GUTZ78 » 17 février 2013, 15:28

Bonjour Lermite :slt:

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
Avatar du membre
lermite
Membre impliqué
Membre impliqué
Messages : 1'599
Inscrit le : 5 février 2012
Version d'Excel : 2000/2007FR

Message par lermite » 17 février 2013, 15:55

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 : http://www.langue-fr.net/index/M/mille.htm#complements)
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. :P
Tout problème a une solution, le vrai problème... c'est de la trouver.
G
GUTZ78
Nouveau venu
Nouveau venu
Messages : 4
Inscrit le : 12 février 2013
Version d'Excel : 2007

Message par GUTZ78 » 17 février 2013, 18:03

Tout d'abord Mea Culpa , maxi Mea Culpa

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

Je me coucherai moins betes ce soir.
Avatar du membre
lermite
Membre impliqué
Membre impliqué
Messages : 1'599
Inscrit le : 5 février 2012
Version d'Excel : 2000/2007FR

Message par lermite » 17 février 2013, 18:09

GUTZ78 a écrit : Je me coucherai moins betes ce soir.
Mais non, mais non.. faut être positif ->> Plus malin ce soir. ;;)
Tout problème a une solution, le vrai problème... c'est de la trouver.
O
OMAR DEBBAGH
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 8 juin 2013
Version d'Excel : 2007 FR

Message par OMAR DEBBAGH » 10 juin 2013, 16:22

salut, comment je peux modifier dans un macro par exemple euro en dirhams et millième en centime merci
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message