A voir également:
- Des chiffres en lettres
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Chiffre en lettre - Télécharger - Outils professionnels
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Trouver une phrase avec des lettres dans le désordre - Forum Loisirs / Divertissements
- Comment activer les chiffres du clavier - Guide
2 réponses
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
