nombre en toutes lettre FR diverse monnaies et autres 7.2

Sub test()
 Debug.Print NblettreUS(25378952.75)
Debug.Print NblettreUS(1000.75)
End Sub

Function NblettreUS(chain As String) As String
    Dim t, dixx&, dix&, cxx&, u&, Part, ms, m, Ul, Diz, n&, I&, seg$, cc$, et$, Ss$, R$, md$, dollar$, cent$
    Ul = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen", "hundred")
    Diz = Array("", "Ten", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
    ms = Array("", " vigintillion", " novemdecillion", " octodecillion", " septendecillion", " sexdecillion", " quindecillion", " quattuordecillion", " tredecillion", " duodecillion", " undecillion", " decillion", " nonillion", " octillion", " septillion", " sextillion", " quintillion", " quadrillion", " trillion", " billion", " million", " thousand", "")
    If LCase(chain) Like "*[a-z|:|;|/|\]*" Then NblettreUS = "Invalid Chaine!!": Exit Function
    Part = Split(chain, ","): If Len(Part(0)) > 66 Then NblettreUS = "OutOFF(CAR*66)!!": Exit Function
    dollar = "dollar" & IIf(Part(0) > 1, "s", "")
    dollar = IIf(UBound(Part) > 0, dollar & " and ", "")
    cent = IIf(UBound(Part) > 0, "Cent", ""): If UBound(Part) > 0 Then If Part(1) = 0 Then Part = Array(Part(0)): cent = "": dollar = Replace(dollar, "and", "")
    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, " hundred ", "")
                        If dixx > 9 And dixx < 20 Then dix = 0: u = u + 10
               md = ms(m):
            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 dollar = ""
        R = R & IIf(n = 0, dollar, cent): If n = 1 Then If Part(1) > 1 Then R = R & "s" & IIf(Part(0) = 0, " dollar", "")
        If Trim(R) = "" Then R = ""
    Next n
    NblettreUS = Application.Trim(R)
End Function