Des chiffres en lettres
Fermé
majorelle02
Messages postés
6
Date d'inscription
dimanche 2 décembre 2007
Statut
Membre
Dernière intervention
21 février 2008
-
14 févr. 2008 à 23:35
Utilisateur anonyme - 14 févr. 2008 à 23:55
Utilisateur anonyme - 14 févr. 2008 à 23:55
A voir également:
- Des chiffres en lettres
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Application pour écrire les chiffre en lettre - Télécharger - Outils professionnels
- Triez cette liste par ordre alphabétique des villes et par note de la meilleure à la moins bonne. quel mot est formé par les 8 premières lettres de la colonne code ? ✓ - Forum Excel
- Mon clavier n'écrit plus les lettres ✓ - Forum Clavier
- Code ascii des lettres - Guide
2 réponses
Utilisateur anonyme
14 févr. 2008 à 23:44
14 févr. 2008 à 23:44
Function EnLettres(cellule) As Variant
Dim Nbr As String
Dim LongueurTexte As Integer
Dim Temp As String
Dim Pos As Integer
Dim iCentaines As Integer
Dim iDizaines As Integer
Dim iUnités As Integer
Dim Unités(2 To 5) As String
Dim bTrouvé As Boolean
Dim Unité As Variant
Dim Dizaines As Variant
Dim Dizaine As Variant
Dim Négatif As Boolean
' Est-ce un nombre ?
If Not IsNumeric(cellule) Then
EnLettres = CVErr(xlErrValue)
Exit Function
End If
' Est-il négatif ?
If cellule < 0 Then
Négatif = True
cellule = Abs(cellule)
End If
Nbr = Format(cellule, "###0.00")
LongueurTexte = Len(Nbr) - 3
' Est-il trop grand?
If LongueurTexte > 15 Then
EnLettres = CVErr(xlErrNum)
Exit Function
End If
Nbr = Left(Nbr, LongueurTexte)
Unité = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
Dizaines = Array("dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
Dizaine = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
Unités(2) = "mille"
Unités(3) = "million"
Unités(4) = "milliards"
Temp = ""
For Pos = 15 To 3 Step -3
If LongueurTexte >= Pos - 2 Then
bTrouvé = False
If LongueurTexte >= Pos Then
iCentaines = Asc(Mid$(Nbr, LongueurTexte - Pos + 1, 1)) - 48
If iCentaines > 0 Then
Temp = Temp & " " & Unité(iCentaines) & " cent"
bTrouvé = True
End If
End If
iDizaines = 0
iUnités = 0
If LongueurTexte >= Pos - 1 Then
iDizaines = Asc(Mid$(Nbr, LongueurTexte - Pos + 2, 1)) - 48
End If
If LongueurTexte >= Pos - 2 Then
iUnités = Asc(Mid$(Nbr, LongueurTexte - Pos + 3, 1)) - 48
End If
If iDizaines = 1 Then
Temp = Temp & " " & Dizaines(iUnités)
bTrouvé = True
Else
If iDizaines >= 2 Then
Temp = Temp & " " & Dizaine(iDizaines)
bTrouvé = True
End If
If iUnités > 0 Then
If iDizaines >= 2 Then
Temp = Temp & "-"
Else
Temp = Temp & " "
End If
Temp = Temp & Unité(iUnités)
bTrouvé = True
End If
End If
If bTrouvé And Pos > 3 Then
Temp = Temp & " " & Unités(Pos \ 3)
End If
End If
Next Pos
EnLettres = Trim(Temp)
If Négatif Then EnLettres = "moins " & EnLettres
End Function
Dim Nbr As String
Dim LongueurTexte As Integer
Dim Temp As String
Dim Pos As Integer
Dim iCentaines As Integer
Dim iDizaines As Integer
Dim iUnités As Integer
Dim Unités(2 To 5) As String
Dim bTrouvé As Boolean
Dim Unité As Variant
Dim Dizaines As Variant
Dim Dizaine As Variant
Dim Négatif As Boolean
' Est-ce un nombre ?
If Not IsNumeric(cellule) Then
EnLettres = CVErr(xlErrValue)
Exit Function
End If
' Est-il négatif ?
If cellule < 0 Then
Négatif = True
cellule = Abs(cellule)
End If
Nbr = Format(cellule, "###0.00")
LongueurTexte = Len(Nbr) - 3
' Est-il trop grand?
If LongueurTexte > 15 Then
EnLettres = CVErr(xlErrNum)
Exit Function
End If
Nbr = Left(Nbr, LongueurTexte)
Unité = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
Dizaines = Array("dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
Dizaine = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
Unités(2) = "mille"
Unités(3) = "million"
Unités(4) = "milliards"
Temp = ""
For Pos = 15 To 3 Step -3
If LongueurTexte >= Pos - 2 Then
bTrouvé = False
If LongueurTexte >= Pos Then
iCentaines = Asc(Mid$(Nbr, LongueurTexte - Pos + 1, 1)) - 48
If iCentaines > 0 Then
Temp = Temp & " " & Unité(iCentaines) & " cent"
bTrouvé = True
End If
End If
iDizaines = 0
iUnités = 0
If LongueurTexte >= Pos - 1 Then
iDizaines = Asc(Mid$(Nbr, LongueurTexte - Pos + 2, 1)) - 48
End If
If LongueurTexte >= Pos - 2 Then
iUnités = Asc(Mid$(Nbr, LongueurTexte - Pos + 3, 1)) - 48
End If
If iDizaines = 1 Then
Temp = Temp & " " & Dizaines(iUnités)
bTrouvé = True
Else
If iDizaines >= 2 Then
Temp = Temp & " " & Dizaine(iDizaines)
bTrouvé = True
End If
If iUnités > 0 Then
If iDizaines >= 2 Then
Temp = Temp & "-"
Else
Temp = Temp & " "
End If
Temp = Temp & Unité(iUnités)
bTrouvé = True
End If
End If
If bTrouvé And Pos > 3 Then
Temp = Temp & " " & Unités(Pos \ 3)
End If
End If
Next Pos
EnLettres = Trim(Temp)
If Négatif Then EnLettres = "moins " & EnLettres
End Function
Utilisateur anonyme
14 févr. 2008 à 23:55
14 févr. 2008 à 23:55
Une autre à télécharger ici (plus complète et plus cool
http://www.excelabo.net/moteurs/compteclic.php?nom=bj-chiffres-en-lettres
http://www.excelabo.net/moteurs/compteclic.php?nom=bj-chiffres-en-lettres