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
Dans un Userform
Téléchargements
Classeur Excel 97 - 2003 :
Classeur Excel 2007 => :
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