Function MSumProp$(Amount#, Optional CurrencyID$ = 0)
' Author MCH (Michael CH.), May 2012
' Modified by bmv jun 2020 - unicode undepending
' CurrencyID
' 0 - Ruble (default) , 1 - Dollar , 2 -Euro
Dim rub$, kop$, I&, m$
If Amount >= 1E+15 Or Amount < 0 Or CurrencyID < 0 Or CurrencyID > 2 Then Exit Function
Static RHundreds, Rdecades, SecDec, Runits, razr
Static RNull, RChangeUnit
If IsEmpty(RNull) Then
RNull = ChrW(1085) & ChrW(1086) & ChrW(1083) & ChrW(1100) & ChrW(32)
End If
If IsEmpty(RChangeUnit) Then
ChangeUnitkopeck = Array( _
ChrW(32) & ChrW(1082) & ChrW(1086) & ChrW(1087) & ChrW(1077), _
ChrW(1077) & ChrW(1082), _
ChrW(1081) & ChrW(1082) & ChrW(1072), _
ChrW(1081) & ChrW(1082) & ChrW(1080))
'" цент" "ов" "" "а"
ChangeUnitCenT = Array( _
ChrW(32) & ChrW(1094) & ChrW(1077) & ChrW(1085) & ChrW(1090), _
ChrW(1086) & ChrW(1074), _
"", _
ChrW(1072))
RChangeUnit = Array(ChangeUnitkopeck, ChangeUnitCenT, ChangeUnitCenT)
End If
'RHundreds= Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
If IsEmpty(RHundreds) Then
RHundreds = UniCodeToStr( _
Array( _
Array(), _
Array(1089, 1090, 1086, 32), _
Array(1076, 1074, 1077, 1089, 1090, 1080, 32), _
Array(1090, 1088, 1080, 1089, 1090, 1072, 32), _
Array(1095, 1077, 1090, 1099, 1088, 1077, 1089, 1090, 1072, 32), _
Array(1087, 1103, 1090, 1100, 1089, 1086, 1090, 32), _
Array(1096, 1077, 1089, 1090, 1100, 1089, 1086, 1090, 32), _
Array(1089, 1077, 1084, 1100, 1089, 1086, 1090, 32), _
Array(1074, 1086, 1089, 1077, 1084, 1100, 1089, 1086, 1090, 32), _
Array(1076, 1077, 1074, 1103, 1090, 1100, 1089, 1086, 1090, 32) _
))
End If
'Rdecades = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
If IsEmpty(Rdecades) Then
Rdecades = UniCodeToStr( _
Array( _
Array(), _
Array(), _
Array(1076, 1074, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1090, 1088, 1080, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1089, 1086, 1088, 1086, 1082, 32), _
Array(1087, 1103, 1090, 1100, 1076, 1077, 1089, 1103, 1090, 32), _
Array(1096, 1077, 1089, 1090, 1100, 1076, 1077, 1089, 1103, 1090, 32), _
Array(1089, 1077, 1084, 1100, 1076, 1077, 1089, 1103, 1090, 32), _
Array(1074, 1086, 1089, 1077, 1084, 1100, 1076, 1077, 1089, 1103, 1090, 32), _
Array(1076, 1077, 1074, 1103, 1085, 1086, 1089, 1090, 1086, 32) _
))
End If
'SecDec = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
If IsEmpty(SecDec) Then
SecDec = UniCodeToStr( _
Array( _
Array(1076, 1077, 1089, 1103, 1090, 1100, 32), _
Array(1086, 1076, 1080, 1085, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1076, 1074, 1077, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1090, 1088, 1080, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1095, 1077, 1090, 1099, 1088, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1087, 1103, 1090, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1096, 1077, 1089, 1090, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1089, 1077, 1084, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1074, 1086, 1089, 1077, 1084, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32), _
Array(1076, 1077, 1074, 1103, 1090, 1085, 1072, 1076, 1094, 1072, 1090, 1100, 32) _
))
End If
'Runits = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
If IsEmpty(Runits) Then
Runits = UniCodeToStr( _
Array( _
Array(), _
Array(1086, 1076, 1080, 1085, 32), _
Array(1076, 1074, 1072, 32), _
Array(1090, 1088, 1080, 32), _
Array(1095, 1077, 1090, 1099, 1088, 1077, 32), _
Array(1087, 1103, 1090, 1100, 32), _
Array(1096, 1077, 1089, 1090, 1100, 32), _
Array(1089, 1077, 1084, 1100, 32), _
Array(1074, 1086, 1089, 1077, 1084, 1100, 32), _
Array(1076, 1077, 1074, 1103, 1090, 1100, 32), _
Array(), _
Array(1086, 1076, 1085, 1072, 32), _
Array(1076, 1074, 1077, 32) _
))
End If
'razrR = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "рубль ", "рубля ", "рублей ")
'razrD = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "доллар ", "доллара ", "долларов ")
'razrE = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "евро ", "евро ", "евро ")
If IsEmpty(razr) Then
razrR = UniCodeToStr( _
Array( _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 32), _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 1072, 32), _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 1086, 1074, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 1072, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 1086, 1074, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 1072, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 1086, 1074, 32), _
Array(1090, 1099, 1089, 1103, 1095, 1072, 32), _
Array(1090, 1099, 1089, 1103, 1095, 1080, 32), _
Array(1090, 1099, 1089, 1103, 1095, 32), _
Array(1088, 1091, 1073, 1083, 1100, 32), _
Array(1088, 1091, 1073, 1083, 1103, 32), _
Array(1088, 1091, 1073, 1083, 1077, 1081, 32) _
))
razrD = UniCodeToStr( _
Array( _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 32), _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 1072, 32), _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 1086, 1074, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 1072, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 1086, 1074, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 1072, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 1086, 1074, 32), _
Array(1090, 1099, 1089, 1103, 1095, 1072, 32), _
Array(1090, 1099, 1089, 1103, 1095, 1080, 32), _
Array(1090, 1099, 1089, 1103, 1095, 32), _
Array(1076, 1086, 1083, 1083, 1072, 1088, 32), _
Array(1076, 1086, 1083, 1083, 1072, 1088, 1072, 32), _
Array(1076, 1086, 1083, 1083, 1072, 1088, 1086, 1074, 32) _
))
razrE = UniCodeToStr( _
Array( _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 32), _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 1072, 32), _
Array(1090, 1088, 1080, 1083, 1083, 1080, 1086, 1085, 1086, 1074, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 1072, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1072, 1088, 1076, 1086, 1074, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 1072, 32), _
Array(1084, 1080, 1083, 1083, 1080, 1086, 1085, 1086, 1074, 32), _
Array(1090, 1099, 1089, 1103, 1095, 1072, 32), _
Array(1090, 1099, 1089, 1103, 1095, 1080, 32), _
Array(1090, 1099, 1089, 1103, 1095, 32), _
Array(1077, 1074, 1088, 1086, 32), _
Array(1077, 1074, 1088, 1086, 32), _
Array(1077, 1074, 1088, 1086, 32) _
))
razr = Array(razrR, razrD, razrE)
End If
rub = Left(Format(Amount, "000000000000000.00"), 15)
kop = Right(Format(Amount, "0.00"), 2)
If CDbl(rub) = 0 Then m = RNull
For I = 1 To Len(rub) Step 3
If Mid(rub, I, 3) <> "000" Or I = Len(rub) - 2 Then
m = m & RHundreds(CInt(Mid(rub, I, 1))) & IIf(Mid(rub, I + 1, 1) = "1", SecDec(CInt(Mid(rub, I + 2, 1))), _
Rdecades(CInt(Mid(rub, I + 1, 1))) & Runits(CInt(Mid(rub, I + 2, 1)) + IIf(I = Len(rub) - 5 And CInt(Mid(rub, I + 2, 1)) < 3, 10, 0))) & _
IIf(Mid(rub, I + 1, 1) = "1" Or (Mid(rub, I + 2, 1) + 9) Mod 10 >= 4, razr(CurrencyID)(I + 1), IIf(Mid(rub, I + 2, 1) = "1", razr(CurrencyID)(I - 1), razr(CurrencyID)(I)))
End If
Next I
MSumProp = UCase(Left(m, 1)) & Mid(m, 2) & kop & RChangeUnit(CurrencyID)(0) & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, RChangeUnit(CurrencyID)(1), IIf(kop Mod 10 = 1, RChangeUnit(CurrencyID)(2), RChangeUnit(CurrencyID)(3)))
End Function
Function UniCodeToStr(ByRef Arr)
Dim I#, J#
ReDim Rez(LBound(Arr) To UBound(Arr)) As String
For I = LBound(Arr) To UBound(Arr)
Rez(I) = ""
For J = LBound(Arr(I)) To UBound(Arr(I))
Rez(I) = Rez(I) & ChrW(Arr(I)(J))
Next
'Debug.Print sotn
Next
UniCodeToStr = Rez
End Function |