Re : Chiffres en lettres TD
Bonjour,
Essayer ce code : à placer dans un module :
fonction à écrire dans cellule =nombretexte(cellule ou nombre;;"€") "€" pour euro
cordialement,
Type libMonnaie 'type décrivant les paramètres d'un pays
libFranc As String 'libellé pour la monnaie principale, au singulier
libFrancs As String 'libellé pour la monnaie principale, au pluriel
libCentime As String 'libellé pour la monnaie secondaire, au singulier
libCentimes As String 'libellé pour la monnaie secondaire, au pluriel
sepDéci As String 'texte de séparation entre partie entière et décimale
nbreDéci As Integer 'nombre de décimales
estMon As Boolean 's'agit-il d'une monnaie
End Type
Function NombreTexte(valConv As String, Optional monnaieDéci As Variant, _
Optional convDéci As Variant) As String
Dim textMon As libMonnaie 'paramètres liés à la monnaie choisie
Dim valEnt As String 'partie entière du nombre
Dim valDéci As String 'partie décimale du nombre
Dim sepDéci As String * 1 'séparateur décimal de l'utilisateur
If Not (IsNumeric(valConv)) Then
NombreTexte = "Pas de nombre détecté"
Exit Function
End If
'If Len(valConv) > 16 Then
If Len(valConv) > 32 Then
NombreTexte = "#Hors Limites!"
Exit Function
End If
If Not IsError(Application.Search("E", valConv)) Then
NombreTexte = "#Hors limites!"
Exit Function
End If
If IsMissing(convDéci) Then convDéci = True
If convDéci = "" Then convDéci = True
If IsMissing(monnaieDéci) Then monnaieDéci = "F"
If monnaieDéci = "" Then monnaieDéci = "F"
If Not (IsNumeric(monnaieDéci)) Then
monnaieDéci = UCase(monnaieDéci)
textMon = ChoixLangue(monnaieDéci)
Else
textMon = ChoixLangue("Aucun")
textMon.nbreDéci = monnaieDéci
End If
If textMon.nbreDéci <> -1 Then
valConv = CStr(Application.Round(CDbl(valConv), textMon.nbreDéci))
If Not IsError(Application.Search("E", valConv)) Then
NombreTexte = "#Hors Limites!"
Exit Function
End If
End If
sepDéci = Application.International(xlDecimalSeparator)
If Fix(CDbl(valConv)) = CDbl(valConv) Then
valEnt = LTrim(valConv)
valDéci = "0"
Else
valEnt = LTrim(Left(valConv, Application.Search(sepDéci, valConv) - 1))
valDéci = Right(valConv, Len(valConv) - _
Application.Search(sepDéci, valConv))
If Len(valDéci) < textMon.nbreDéci Then
For i = 1 To textMon.nbreDéci - Len(valDéci)
valDéci = valDéci & "0"
Next
End If
End If
If CDbl(valConv) = 0 Then
NombreTexte = "Zéro" & textMon.libFranc
Else
NombreTexte = ""
If Left(valEnt, 1) = "-" Then
NombreTexte = "moins "
valEnt = Right(valEnt, Len(valEnt) - 1)
End If
If CDbl(valEnt) = 0 Then
NombreTexte = NombreTexte & "Zéro"
Else
NombreTexte = NombreTexte & ConvTexte(valEnt, textMon.estMon, False)
End If
If valEnt <> "un" And valEnt <> "1" Then
NombreTexte = NombreTexte & textMon.libFrancs
Else
NombreTexte = NombreTexte & textMon.libFranc
End If
If textMon.estMon Then
Do While Left(valDéci, 1) = "0" And Len(valDéci) > 1
valDéci = Right(valDéci, Len(valDéci) - 1)
Loop
End If
If valDéci <> "0" Then
NombreTexte = NombreTexte & textMon.sepDéci
If convDéci Then
NombreTexte = NombreTexte & ConvTexte(valDéci, textMon.estMon, True)
Else
NombreTexte = NombreTexte & valDéci
End If
If valDéci <> "un" And valDéci <> "1" Then
NombreTexte = NombreTexte & textMon.libCentimes
Else
NombreTexte = NombreTexte & textMon.libCentime
End If
End If
End If
End Function
Private Function ChoixLangue(ByVal codePays As String) As libMonnaie
Select Case codePays
Case "F"
ChoixLangue.libFranc = " franc"
ChoixLangue.libFrancs = " francs"
ChoixLangue.libCentime = " centime"
ChoixLangue.libCentimes = " centimes"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
'Comme pour le franc, les montants en euros s'expriment avec deux
'chiffres après la virgule parce que la plus petite subdivision sera
'le "*cent*" d'euro.
'les valeurs des billets (5, 10, 20, 50, 100, 200, 500 euros)
'et des pièces (1, 2, 5, 10, 20, 50 cents), et (1 et 2 euros)
'étaient définies par accord des Quinze dès 1995.
Case "€"
ChoixLangue.libFranc = " Euro"
ChoixLangue.libFrancs = " Euros"
ChoixLangue.libCentime = " centime" '(d'euro)"
ChoixLangue.libCentimes = " centimes" '(d'euro)"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "$US"
ChoixLangue.libFranc = " dollar"
ChoixLangue.libFrancs = " dollars"
ChoixLangue.libCentime = " cent"
ChoixLangue.libCentimes = " cents"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "£"
ChoixLangue.libFranc = " livre"
ChoixLangue.libFrancs = " livres"
ChoixLangue.libCentime = " penny"
ChoixLangue.libCentimes = " pence"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "DM"
ChoixLangue.libFranc = " mark"
ChoixLangue.libFrancs = " marks"
ChoixLangue.libCentime = " pfennig"
ChoixLangue.libCentimes = " pfennige"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "PTA"
ChoixLangue.libFranc = " peseta"
ChoixLangue.libFrancs = " pesetas"
ChoixLangue.libCentime = " céntimo"
ChoixLangue.libCentimes = " céntimos"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "DTU"
ChoixLangue.libFranc = " dinar"
ChoixLangue.libFrancs = " dinars"
ChoixLangue.libCentime = " millime"
ChoixLangue.libCentimes = " millimes"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 3
ChoixLangue.estMon = True
Case "Y"
ChoixLangue.libFranc = " yen"
ChoixLangue.libFrancs = " yen"
ChoixLangue.libCentime = " sen"
ChoixLangue.libCentimes = " sen"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case Else
ChoixLangue.libFranc = ""
ChoixLangue.libFrancs = ""
ChoixLangue.libCentime = ""
ChoixLangue.libCentimes = ""
ChoixLangue.sepDéci = " virgule "
ChoixLangue.nbreDéci = -1
ChoixLangue.estMon = False
End Select
End Function
Private Function ConvTexte(sourceConv As String, estMonnaie As Boolean, _
zéroGauche As Boolean) As String
ConvTexte = ""
Do While Left(sourceConv, 1) = "0"
If zéroGauche Then ConvTexte = ConvTexte & "zéro "
sourceConv = Right(sourceConv, Len(sourceConv) - 1)
Loop
Select Case Len(sourceConv)
Case 1, 2, 3
ConvTexte = ConvTexte & ConvCent(sourceConv, True)
Case 4, 5, 6
Select Case Left(sourceConv, Len(sourceConv) - 3)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001"
If Right(sourceConv, 3) = "000" Then
'Dernir texte
ConvTexte = ConvTexte & "mille"
Else
ConvTexte = ConvTexte & "mille " & ConvTexte(Right(sourceConv, 3), estMonnaie, _
False)
End If
Case Else
If Right(sourceConv, 3) = "000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 3), _
False) & " mille"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 3), _
False) & " mille " & ConvTexte(Right(sourceConv, 3), _
estMonnaie, False)
End If
End Select
Case 7, 8, 9
Select Case Left(sourceConv, Len(sourceConv) - 6)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001"
If Right(sourceConv, 6) = "000000" Then
ConvTexte = ConvTexte & "un million"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & "un million " & ConvTexte(Right(sourceConv, 6), _
estMonnaie, False)
End If
Case Else
If Right(sourceConv, 6) = "000000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 6), _
True) & " millions"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 6), _
True) & " millions " & ConvTexte(Right(sourceConv, 6), _
estMonnaie, False)
End If
End Select
Case 10, 11, 12
Select Case Left(sourceConv, Len(sourceConv) - 9)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001"
If Right(sourceConv, 9) = "000000000" Then
ConvTexte = ConvTexte & "un milliard"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & "un milliard " & ConvTexte(Right(sourceConv, 9), _
estMonnaie, False)
End If
Case Else
If Right(sourceConv, 9) = "000000000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 9), _
True) & " milliards"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 9), _
True) & " milliards " & ConvTexte(Right(sourceConv, 9), _
estMonnaie, False)
End If
End Select
Case 13, 14, 15
Select Case Left(sourceConv, Len(sourceConv) - 12)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001" '1 seul billion
If Right(sourceConv, 12) = "000000000000" Then
'Dernier texte
ConvTexte = ConvTexte & "un billion"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & "un billion " & ConvTexte(Right(sourceConv, 12), _
estMonnaie, False)
End If
Case Else
If Right(sourceConv, 12) = "000000000000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 12), _
True) & " billions"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 12), _
True) & " billions " & ConvTexte(Right(sourceConv, _
12), estMonnaie, False)
End If
End Select
Case Else
ConvTexte = "#Hors Limites!"
End Select
ConvTexte = LTrim(RTrim(ConvTexte))
End Function
Private Function ConvCent(source As String, estFinal As Boolean) As String
Dim tabUnit As Variant
Dim tabDixUnit As Variant
Dim tabDixaine As Variant
tabUnit = Array("zéro", "un", "deux", "trois", "quatre", "cinq", "six", _
"sept", "huit", "neuf")
tabDixUnit = Array("dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
tabDixaine = Array("", "dix", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
Select Case Len(source)
Case 1
ConvCent = tabUnit(CDbl(source))
Case 2
Select Case Left(source, 1)
Case "0"
ConvCent = ConvCent(Right(source, 1), estFinal)
Case "1"
ConvCent = tabDixUnit(CDbl(Right(source, 1)))
Case "2", "3", "4", "5", "6"
Select Case Right(source, 1)
Case "0"
ConvCent = tabDixaine(CDbl(Left(source, 1)))
Case "1"
ConvCent = tabDixaine(CDbl(Left(source, 1))) & " et un"
Case Else
ConvCent = tabDixaine(CDbl(Left(source, 1))) & "-" & _
ConvCent(Right(source, 1), estFinal)
End Select
Case "7"
Select Case Right(source, 1)
Case "0"
ConvCent = tabDixaine(CDbl(Left(source, 1)))
Case "1"
ConvCent = "soixante et onze"
Case Else
ConvCent = "soixante-" & ConvCent("1" & Right(source, 1), _
estFinal)
End Select
Case "8"
If Right(source, 1) = "0" Then
If estFinal Then
ConvCent = "quatre-vingts"
Else
ConvCent = "quatre-vingt"
End If
Else
ConvCent = "quatre-vingt-" & ConvCent(Right(source, 1), estFinal)
End If
Case "9"
ConvCent = "quatre-vingt-" & ConvCent("1" & Right(source, 1), _
estFinal)
End Select
Case 3
Select Case Left(source, 1)
Case "0"
ConvCent = ConvCent(Right(source, 2), estFinal)
Case "1"
If Right(source, 2) = "00" Then
ConvCent = "cent"
Else
ConvCent = "cent " & ConvCent(Right(source, 2), estFinal)
End If
Case Else
If Right(source, 2) = "00" Then
If estFinal Then
ConvCent = ConvCent(Left(source, 1), estFinal) & " cents"
Else
ConvCent = ConvCent(Left(source, 1), estFinal) & " cent"
End If
Else
ConvCent = ConvCent(Left(source, 1), estFinal) & " cent " & _
ConvCent(Right(source, 2), estFinal)
End If
End Select
End Select
End Function
