Des chiffres en lettres

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

Une autre à télécharger ici (plus complète et plus cool

http://www.excelabo.net/moteurs/compteclic.php?nom=bj-chiffres-en-lettres