Function el_callet(ByVal chiffre, ByVal monai)
Dim i As Integer, t As Integer, cchif As String, tchif As String
Dim aniveau(1, 1), texte As String
Dim arangs(9, 3), aexcep(12, 3), avcex(2, 3), amil(5)
Dim longchaine As Integer
longchaine = Len(chiffre)
If VarType(monai) = VariantType.Boolean Then
monai = "€uros"
End If
' chiffre = IIf(VarType(chiffre) = VariantType.String, CDec(chiffe), chiffre)
chiffre = Conversion.Val(chiffre)
chiffre = IIf(VarType(chiffre) <> VariantType.String And chiffre < 0, chiffre * -1, chiffre)
cchif = LTrim(Format(Decimal.Round(IIf(VarType(chiffre) = VariantType.String, Val(chiffre), chiffre), 2), "###############.##"))
tchif = Left(cchif, Len(cchif) - 3)
texte = ""
arangs(1, 1) = "cent "
arangs(1, 2) = "dix "
arangs(1, 3) = "un "
arangs(2, 1) = "deux cents "
arangs(2, 2) = "vingt "
arangs(2, 3) = "deux "
arangs(3, 1) = "trois cents "
arangs(3, 2) = "trente "
arangs(3, 3) = "trois "
arangs(4, 1) = "quatre cents "
arangs(4, 2) = "quarante "
arangs(4, 3) = "quatre "
arangs(5, 1) = "cinq cents "
arangs(5, 2) = "cinquante "
arangs(5, 3) = "cinq "
arangs(6, 1) = "six cents "
arangs(6, 2) = "soixante "
arangs(6, 3) = "six "
arangs(7, 1) = "sept cents "
arangs(7, 2) = "soixante dix "
arangs(7, 3) = "sept "
arangs(8, 1) = "huit cents "
arangs(8, 2) = "quatre vingts "
arangs(8, 3) = "huit "
arangs(9, 1) = "neuf cents "
arangs(9, 2) = "quatre vingt dix "
arangs(9, 3) = "neuf "
amil(1) = monai
amil(2) = "mille"
amil(3) = "million"
amil(4) = "milliard"
amil(5) = "billion"
aexcep(1, 1) = "dix un"
aexcep(1, 2) = "onze"
aexcep(2, 1) = "dix deux"
aexcep(2, 2) = "douze"
aexcep(3, 1) = "dix trois"
aexcep(3, 2) = "treize"
aexcep(4, 1) = "dix quatre"
aexcep(4, 2) = "quatorze"
aexcep(5, 1) = "dix cinq"
aexcep(5, 2) = "quinze"
aexcep(6, 1) = "dix six"
aexcep(6, 2) = "seize"
aexcep(7, 1) = "vingt un"
aexcep(7, 2) = "vingt et un"
aexcep(8, 1) = "trente un"
aexcep(8, 2) = "trente et un"
aexcep(9, 1) = "quarante un"
aexcep(9, 2) = "quarante et un"
aexcep(10, 1) = "cinquante un"
aexcep(10, 2) = "cinquante et un"
aexcep(11, 1) = "soixante un"
aexcep(11, 2) = "soixante et un"
aexcep(12, 1) = "soixante onze"
aexcep(12, 2) = "soixante et onze"
avcex(1, 1) = "vingts"
avcex(1, 2) = "vingt"
avcex(2, 1) = "cents"
avcex(2, 2) = "cent"
i = 1
ReDim aniveau(Len(tchif) + 1, 2)
For i = 1 To Len(tchif) + 1
aniveau(i, 0) = ""
aniveau(i, 1) = ""
aniveau(i, 2) = ""
Next
i = 1
Do While True
If i = 1 Then
aniveau(1, 1) = Right(tchif, IIf(Len(tchif) > 2, 3, Len(tchif)))
aniveau(1, 2) = ""
Else
aniveau(i, 1) = Right(tchif, IIf(Len(tchif) > 2, 3, Len(tchif)))
aniveau(i, 2) = ""
End If
i = i + 1
If Len(tchif) >= 3 Then
tchif = Left(tchif, Len(tchif) - 3)
End If
If Len(tchif) = 2 Then
tchif = Left(tchif, 1)
End If
If Len(tchif) = 1 Then
tchif = Left(tchif, 0)
End If
If Len(tchif) = 0 Then Exit Do
Loop
For i = 1 To ((aniveau.Length) / 3) - 1
'i = 0
aniveau(i, 1) = IIf(aniveau(i, 1).Length < 3, padl(aniveau(i, 1), 3, "0"), aniveau(i, 1))
For t = 1 To aniveau(i, 1).Length
If aniveau(i, 1).Substring(t - 1, 1) <> "0" Then
aniveau(i, 2) = aniveau(i, 2) + arangs(Val(aniveau(i, 1).Substring(t - 1, 1)), t)
End If
Next
If i > 1 And aniveau(i, 1) <> "000" Then
aniveau(i, 2) = aniveau(i, 2) + amil(i) + IIf(Val(aniveau(i, 1)) > 1 And i > 2, "s ", " ")
End If
Next
For i = alen(aniveau) / 3 - 1 To 1 Step -1
texte = texte + aniveau(i, 2)
Next
' traite les exceptions
For i = 1 To 11
texte = Replace(texte, aexcep(i, 1), aexcep(i, 2))
Next i
' aeval(aexcep,{|a|texte:=strtran(texte,a[1],a[2])})
'// enlŠve un mille
texte = IIf(Left(texte, 8) = "un mille", Right(texte, Len(texte) - 3), texte)
'// vingt et cent
For i = 0 To 1
texte = Replace(Left(texte, Len(texte) - 4), avcex(i, 0), avcex(i, 2)) + Right(texte, 4)
Next
' aeval(avcex,{|a|texte:=strtran(left(texte,len(texte)-4),a[1],a[2])+right(texte,4)})
texte = texte + IIf(Len(alltrim(texte)) > 2, amil(1) + "s ", IIf(alltrim(texte) <> "", amil(1) + " ", "zéro " + amil(2) + " "))
texte = texte + IIf(Val(Right(cchif, 2)) > 0, IIf(Val(Right(cchif, 2)) > 1, Right(cchif, 2) + " centimes", Right(cchif, 2) + " centime"), "")
Return texte
End Function
|
Retour à la liste
France
Fiche personnelle
Note des membres
Niveau
débutant
Le téléchargement des pièces jointes est limité aux membres