' *******************************************************************************************************
' * <<<<convertion un nombre en toute lettre en fonction de la monnaie "Euro">>>> *
' * *
' * Auteur:patricktoulon pour exceldownload *
' * Version:2.0 *
' * Date version:28/10/2019 *
' * Old version Date 22/04/2013 sur developpez.com
' * Methode compact par tranche de 3 caracteres numerique *
' * longueur maximale de chaine; 66 caracteres pour l'entier soit 999 décilliard ..... *
' * *
' * renvoie ""OutOFF(CAR*66)!!"" si la chaine est plus longue que 66 caracteres *
' * renvoie ""Invalid Chaine!!"" n'est pas ou pas completement numerique *
' * *
' *******************************************************************************************************
Option Explicit
Sub test()
Debug.Print NblettreFR(380)
Debug.Print NblettreFR(100)
Debug.Print NblettreFR(1000)
Debug.Print NblettreFR(1000000000#)
Debug.Print NblettreFR(10020000000#)
Debug.Print NblettreFR(1000000)
Debug.Print NblettreFR(31000)
Debug.Print NblettreFR(0)
Debug.Print NblettreFR(371)
Debug.Print NblettreFR(853)
Debug.Print NblettreFR("191471851,56")
Debug.Print NblettreFR(191471851.56)
Debug.Print NblettreFR("135761973946357916972394685379,56")
End Sub
Sub test2()
MsgBox NblettreFR("999994542365897698745632155546325698763218965423698745325698745288,10")
End Sub
Function NblettreFR(chain As String) As String
Dim t, dixx&, dix&, cxx&, u&, Part, ms, m, Ul, Diz, n&, I&, seg$, cc$, et$, Ss$, R$, md$, euro$, centime
Ul = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "cent ")
Diz = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix", "cent")
ms = Array("", " decilliard", " decillion", " nonilliard", " nonillion", " octillard", " octillion", " septilliard", " septillion", " sextilliard", " sextillion", " quintilliard ", " Quintillion", " quadrilliard", " quadrillion", " trilliard", " trillion", " Billiard", " billion", " milliard", " million", " mille", "")
If LCase(chain) Like "*[a-z|:|;|/|\]*" Then NblettreFR = "Invalid Chaine!!": Exit Function
Part = Split(chain, ","): If Len(Part(0)) > 66 Then NblettreFR = "OutOFF(CAR*66)!!": Exit Function
euro = IIf(Val(Part(0)) > 999000 And Val(Right(Part(0), 6)) = 0, "d'euro", "euro") & IIf(Part(0) > 1, "s ", " ") & IIf(UBound(Part) > 0, "et ", "")
centime = IIf(UBound(Part) > 0, "Centime", ""): If UBound(Part) > 0 Then If Part(1) = 0 Then Part = Array(Part(0)): centime = "": euro = Replace(euro, "et", "")
For n = LBound(Part) To UBound(Part)
t = Split(Trim(Format(String((300 - Len(Part(n))) Mod 3, "0") & Part(n), WorksheetFunction.Rept(" @@@", Len(String((300 - Len(Part(n))) Mod 3, "0") & Part(n)) / 3))))
If n = 1 Then If Len(Part(1)) = 1 Then t = Array("0" & Part(1) & "0") 'ajustement centime(0.5 = 0.50)
m = UBound(ms) - UBound(t)
For I = LBound(t) To UBound(t)
cxx = Left(t(I), 1): dixx = Right(t(I), 2): dix = Mid(t(I), 2, 1): u = Right(t(I), 1)
If cxx = 1 Then cxx = 20: cc = "" Else cc = IIf(cxx > 0, " cent ", "")
If dix = 9 Or dix = 7 Then dix = dix - 1: u = Val(u) + 10
If dixx > 9 And dixx < 20 Then dix = 0: u = u + 10
If dix >= 2 And dix <= 7 And (u = 1 Or u = 11) Then et = " et " Else et = IIf(dix <> 0 And u <> 0, "-", " ")
If dixx = 80 Then Ss = "s" Else Ss = ""
If I = UBound(t) - 1 And Part(0) = 1000 Then u = 0
md = ms(m): If Val(t(I)) > 1 And I < UBound(t) - 1 Then md = md & "s"
R = R & Application.Trim(Ul(cxx) & cc & Diz(dix) & et & Ul(u)) & Ss & IIf(Val(t(I)) > 0, md, "") & " "
m = m + 1
Next
If Val(Part(0)) = 0 Then euro = ""
R = R & IIf(n = 0, euro, centime): If n = 1 Then If Part(1) > 1 Then R = R & "s" & IIf(Part(0) = 0, " d'euro", "")
If Trim(R) = "" Then R = ""
Next n
NblettreFR = Application.Trim(R)
End Function
