Convertir un nombre, en lettre

bonjour,

télécharge Morefunc.xll 5.05
http://xcell05.free.fr/morefunc/french/index.htm
ce .xll inclut 66 nouvelles fonctions dont la fonction :
NBTEXTE Transcrit un nombre en toutes lettres (13 langues supportées)

isabelle

SJTNOI93160 a écrit :

Bonjour,

Dans Excel 2003, je recherche la formule qui me permettre de mettre en
lettre une somme en Euros.

Merci de me dire si cela est possible et le cas échéant comment dois-je faire.

Une façon de faire, tu copies le tout dans un module standard :

Quelques exemples de syntaxe pour l'appel de la fonction :

Cette fonction transforme seulement les entiers en lettres et les décimales
demeurent en nombre
'-------------------------------------------
Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "Dollars", "centimes", 2, " ")

End Sub
'-------------------------------------------

Et l'appel dans une cellule : =NumText(B2;;;2;"et ")


Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As
Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
TUnités = Array("", "un", "deux", "trois", "quatre", "cinq", "six", _
"sept", "huit", "neuf", "dix", "onze", "douze", "treize", _
"quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
If Classe = 0 Then Exit Function
' Pas de un pour mille
If Classe = 1 And no_Classe = 1 Then
TxtClasse = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un s sauf pour mille
TxtClasse = TClasses(no_Classe) & IIf(no_Classe > 1 And _
Classe > 1, "s", "") & IIf(no_Classe > 0, " ", "")
' Résultat ----------
TxtClasse = TxtCentaines & TxtDizaines & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

_____________________________________________________________
Deuxième façon de procéder : Paru ici sous la plume de Yougy
______________________________________________________________
Cette fonction transforme les entiers et les décimales en lettres

Pour appeler cette fonction : =ChiffreLettre(240.39)


Function chiffrelettre(s) ' Youky

Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix
sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt
quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et
un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente
sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante
trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit",
_
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize",
_
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix
sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "Euros", "billion", _
"milliard", "million", "mille", "Euro")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "Euros" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un Euros" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Euros" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp):
GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
chiffrelettre = t & d & myct
End Function

"SJTNOI93160" <SJTNOI93160@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : 92064563-CA7C-439E-BC1B-96BBA22519DA@microsoft.com...
Bonjour,

Dans Excel 2003, je recherche la formule qui me permettre de mettre en
lettre une somme en Euros.

Merci de me dire si cela est possible et le cas échéant comment dois-je faire.