Сумма прописью VBA для UNICODE

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

16.06.2020 09:06:36

У иносранцев был вопрос
и так как VBA не работает с UNICODE пришлось помочь. Так как ТС взял вариант Михаила MCH, то его вариант и корежил.
Вот что вышло

Скрытый текст

Код

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

Естественно для надстройки все это проще. На лист положил и проблем нет.

Изменено: БМВ - 21.06.2020 23:07:52

По вопросам из тем форума, личку не читаю.

sokol92

Пользователь

Сообщений: 4861 Регистрация: 10.09.2017

16.06.2020 14:27:48

Добрый день, Михаил! Поскольку правила русского языка в этой части (числительные) вряд ли в ближайшее время поменяются, данное Вами решение я считаю оптимальным.

Где-то у меня был макрос (на скорую руку не нашел), который сканировал модуль VBA на предмет наличия "плохих" текстовых литералов, менял эти литералы на элементы (статического) массива уровня модуля и генерировал подпрограмму для заполнения этого массива - подход, аналогичный примененному Вами.

Владимир

БМВ Модератор Сообщений: 24801 Регистрация: 28.12.2016 Excel 2013, 2016, 2021	#3 16.06.2020 14:38:23 sokol92, Владимир, ну подход то к числительным не мой, а другого Михаила, я только натянул независимость от региональных настроек немного. По вопросам из тем форума, личку не читаю.

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#4 16.06.2020 15:26:56 Я имел в виду, что этот текст не придется часто менять. Хотя, если кто-то знает юникод на память... Владимир

БМВ

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

16.06.2020 15:46:38

sokol92,
я для простоты себе сделал
''Helper function

Код
'Function strtoUni(ele) ''For Each ele In razr ' R = "" ' For I = 1 To Len(ele) ' R = R & "," & AscW(Mid(ele, I, 1)) ' Next ' Debug.Print "array(" & Mid(R, 2) & "), _" ''Next ' 'End Function

По вопросам из тем форума, личку не читаю.

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#6 16.06.2020 16:39:04 Надо же, а я думал Вы руками каждый символ вбивали... Владимир

Игорь

Пользователь

Сообщений: 3697 Регистрация: 23.12.2012

17.06.2020 03:38:59

Цитата
VBA не работает с UNICODE

хм.. а я думал, что работает
По крайней мере, с кириллицей в коде ничего не случится (VBA код не повредится), - если она установлена на компе пользователя, он увидит читаемое сообщение в 99% случаев (кроме редких русскоязычный пользователей с изначально англоязычной виндой, ибо там кодовая страница другая)
А если не установлена, — этот пользователь скорее всего русским языком не владеет, и нет никакого смысла выводить ему текст на русском языке.
Единственное, что в коде нельзя, - это названия макросов и кодовые имена листов / книг на кириллице (это может вызвать неработоспособность некоторых макросов)
Или я не угадал?

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

БМВ

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

17.06.2020 08:33:08

Цитата
Игорь написал: Или я не угадал?

Игорь, это не зависит от языка интерфейса, все зависит от региональных настроек и именно от этого

Но не зависимо от знаний русского у иностранцев может быть потребность вывести что либо на Русском, также как и у нас на арабском. В этом случае все что на листе прекрасно работает, но вот VBA код.... Совершенно недавно разбирали

Более того тут я помнится сломал себе все

По вопросам из тем форума, личку не читаю.

sokol92

Пользователь

Сообщений: 4861 Регистрация: 10.09.2017

17.06.2020 13:05:18

Добрый день! Чтобы побывать в шкуре иностранца, занесите в ячейку A1 греческую букву "Α" и выдайте

Код
Msgbox Range("A1")

Получите "?" (если у Вас, конечно, кодировкой по умолчанию не является Windows-1253).
Борьба с "нехорошими" текстовыми литералами в VBA является самым трудоемким шагом в обеспечении переносимости приложений на Excel VBA. Подробнее здесь.

Владимир

Hugo Пользователь Сообщений: 26518 Регистрация: 22.12.2012	#10 17.06.2020 13:19:25 Нужно было иностранцу предложить UDF названную латиницей. Например доработать вот ту изначальную https://www.planetaexcel.ru/techniques/7/46/ и дать ему уже в файле. Изменено: Hugo - 17.06.2020 13:20:49

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#11 17.06.2020 14:08:51 Здравствуйте, Игорь! Михаил именно это и сделал (функции аналогичны). Владимир

Hugo

Пользователь

Сообщений: 26518 Регистрация: 22.12.2012

#12

17.06.2020 14:20:56

Здравствуйте, Владимир! Не, я говорю о том, что для проверки сперва поменять только название, и дать файл - может оно и так полетит.
Ну а для того чтоб он мог копировать/изменять код - тогда вероятно кириллицу в коде нужно убирать.

Изменено: Hugo - 17.06.2020 14:22:41

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#13 17.06.2020 14:38:46 Точно не полетит, если кодовая страница по умолчанию отлична от Windows 1251 - см. ссылку из #9. Владимир

Hugo Пользователь Сообщений: 26518 Регистрация: 22.12.2012	#14 17.06.2020 14:44:30 Но всё же - что будет результатом такой функции в ячейке? Изменено: Hugo - 17.06.2020 14:44:45

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#15 17.06.2020 14:47:56 Если аргумент функции равен 1, то для Windows-1252 будет îäèí (юникод U+00EE, U+00E4, U+00E8, U+00ED) Изменено: sokol92 - 17.06.2020 15:09:23 Владимир

БМВ

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

#16

17.06.2020 14:48:43

Hugo, исходной? Ничего хорошего, точнее то что было с персидским календарем

Цитата
sokol92 написал: Windows-1252 будет îäèí

эээээээ не понял

Изменено: БМВ - 17.06.2020 14:50:49

По вопросам из тем форума, личку не читаю.

Hugo Пользователь Сообщений: 26518 Регистрация: 22.12.2012	#17 17.06.2020 14:56:09 Я предлагаю вот что проверить - дать тому иносранцу файл, в котором уже есть и работает UDF SummaPropisju(n As Double) и посмотреть на результат. Он ведь может в ячейку прописать кириллицу.

БМВ Модератор Сообщений: 24801 Регистрация: 28.12.2016 Excel 2013, 2016, 2021	#18 17.06.2020 15:03:17 Hugo, так это можно и самостоятельно проверить, сменив то что указано №8 просто перезагрузка нужна. Но уверяю плохо будет :-) По вопросам из тем форума, личку не читаю.

sokol92

Пользователь

Сообщений: 4861 Регистрация: 10.09.2017

#19

17.06.2020 15:04:52

Именно этот эксперимент проделан в #15 (у нас есть система Windows-1252). Русские буквы (один) заменились на символы с тем же номером в кодовой таблице Windows-1252 (благодаря односимвольному формату хранения текстов модулей VBA в проекте Excel).

Изменено: sokol92 - 17.06.2020 15:11:22

Владимир

Hugo Пользователь Сообщений: 26518 Регистрация: 22.12.2012	#20 17.06.2020 15:08:36 Спасибо. Понятно.

БМВ

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

#21

21.06.2020 12:47:20

У иностранцев появилась потребность еще и в Украинском

Скрытый текст

Код

  Option Explicit
 Option Base 0
 
Function MSumProp$(Amount#, Optional CurrencyID% = 0, Optional LanguageID% = 0)
' Author MCH (Michael CH.), May 2012
' Modified by bmv jun 2020 - unicode undepending
' CurrencyID
'    0 - Ruble (default) , 1 - hryvnia, 2 - Dollar , 3 - Euro ,
' LanguageID
'    0 - Russian , 1 - Ukrainian


Dim rub$, kop$, i&, m$
If Amount >= 1E+15 Or Amount < 0 Or CurrencyID < 0 Or CurrencyID > 3 Then Exit Function
Static THundreds(0 To 1), Tdecades(0 To 1), TSecDec(0 To 1), Tunits(0 To 1), Trazr(0 To 1)
Static TNull, TChangeUnit
Dim razrR, razrD, razrE, razrH, ChangeUnitkopeck, ChangeUnitCent, RChangeUnit, UChangeUnit

' TNull = Array("ноль ", "нуль ")
'If IsEmpty(TNull) Then
'TNull = UniCodeToStr(Array( _
'    Array(1085, 1086, 1083, 1100, 32), _
'    Array(1085, 1091, 1083, 1100, 32)))
'End If

If IsEmpty(TNull) Then
TNull = UniCodeToStr(Array( _
    Split("1085 1086 1083 1100 32"), _
    Split("1085 1091 1083 1100 32")))
End If

If IsEmpty(TChangeUnit) Then
    ' Russian
    '" копе","ек","йка","йки"
    ChangeUnitkopeck = UniCodeToStr(Array( _
        Array(32, 1082, 1086, 1087, 1077), _
        Array(1077, 1082), _
        Array(1081, 1082, 1072), _
        Array(1081, 1082, 1080)))
    '" цент" "ов" "" "а"
    ChangeUnitCent = UniCodeToStr(Array( _
        Array(32, 1094, 1077, 1085, 1090), _
        Array(1086, 1074), _
        Array(), _
        Array(1072)))
    RChangeUnit = Array(ChangeUnitkopeck, ChangeUnitkopeck, ChangeUnitCent, ChangeUnitCent)
    'Ukrainian
    '" копі", "йок", "йка", "йки"
    ChangeUnitkopeck = UniCodeToStr(Array( _
        Array(32, 1082, 1086, 1087, 105), _
        Array(1081, 1086, 1082), _
        Array(1081, 1082, 1072), _
        Array(1081, 1082, 1080)))
    '" цент" "ів" "" "центи"
    ChangeUnitCent = UniCodeToStr(Array( _
        Array(32, 1094, 1077, 1085, 1090), _
        Array(1110, 1074), _
        Array(), _
        Array(1080)))
    UChangeUnit = Array(ChangeUnitkopeck, ChangeUnitkopeck, ChangeUnitCent, ChangeUnitCent)
    
    TChangeUnit = Array(RChangeUnit, UChangeUnit)
End If
If IsEmpty(THundreds(0)) Then
    'Russian
    'RHundreds= Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
    THundreds(0) = 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) _
        ))
    'Ukrainian
    'UHundreds = Array("", "сто ", "двісті ", "триста ", "чотириста ", "п'ятсот ", "шістсот ", "сімсот ", "вісімсот ", "дев'ятсот ")
    THundreds(1) = UniCodeToStr( _
        Array( _
            Array(), _
            Array(1089, 1090, 1086, 32), _
            Array(1076, 1074, 1110, 1089, 1090, 1110, 32), _
            Array(1090, 1088, 1080, 1089, 1090, 1072, 32), _
            Array(1095, 1086, 1090, 1080, 1088, 1080, 1089, 1090, 1072, 32), _
            Array(1087, 39, 1103, 1090, 1089, 1086, 1090, 32), _
            Array(1096, 1110, 1089, 1090, 1089, 1086, 1090, 32), _
            Array(1089, 1110, 1084, 1089, 1086, 1090, 32), _
            Array(1074, 1110, 1089, 1110, 1084, 1089, 1086, 1090, 32), _
            Array(1076, 1077, 1074, 39, 1103, 1090, 1089, 1086, 1090, 32) _
        ))
     
End If

'Rdecades = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
'Udecades  = Array("", "", "двадцять ", "тридцять ", "сорок ", "п'ятдесят ", "шістдесят ", "сімдесят ", "вісімдесят ", "дев'яносто ")

If IsEmpty(Tdecades(0)) Then
'Rdecades = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")

    Tdecades(0) = 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) _
        ))
'Udecades  = Array("", "", "двадцять ", "тридцять ", "сорок ", "п'ятдесят ", "шістдесят ", "сімдесят ", "вісімдесят ", "дев'яносто ")
 
    Tdecades(1) = UniCodeToStr( _
        Array( _
            Array(), _
            Array(), _
            Array(1076, 1074, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1090, 1088, 1080, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1089, 1086, 1088, 1086, 1082, 32), _
            Array(1087, 39, 1103, 1090, 1076, 1077, 1089, 1103, 1090, 32), _
            Array(1096, 1110, 1089, 1090, 1076, 1077, 1089, 1103, 1090, 32), _
            Array(1089, 1110, 1084, 1076, 1077, 1089, 1103, 1090, 32), _
            Array(1074, 1110, 1089, 1110, 1084, 1076, 1077, 1089, 1103, 1090, 32), _
            Array(1076, 1077, 1074, 39, 1103, 1085, 1086, 1089, 1090, 1086, 32) _
        ))
End If


If IsEmpty(TSecDec(0)) Then
    
    TSecDec(0) = 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) _
        ))
'USecDec = Array("десять ", "одинадцять ", "дванадцять ", "тринадцять ", "чотирнадцять ", "п'ятнадцять ", "шістнадцять ", "сімнадцять ", "вісімнадцять ", "дев'ятнадцять ")
    TSecDec(1) = UniCodeToStr( _
        Array( _
            Array(1076, 1077, 1089, 1103, 1090, 1100, 32), _
            Array(1086, 1076, 1080, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1076, 1074, 1072, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1090, 1088, 1080, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1095, 1086, 1090, 1080, 1088, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1087, 39, 1103, 1090, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1096, 1110, 1089, 1090, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1089, 1110, 1084, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1074, 1110, 1089, 1110, 1084, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32), _
            Array(1076, 1077, 1074, 39, 1103, 1090, 1085, 1072, 1076, 1094, 1103, 1090, 1100, 32) _
        ))
End If


If IsEmpty(Tunits(0)) Then
'Runits = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
    Tunits(0) = 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) _
        ))
'Uunits = Array("", "один ", "два ", "три ", "чотири ", "п'ять ", "шість ", "сім ", "вісім ", "дев'ять ", "", "одна ", "дві ")
    Tunits(1) = UniCodeToStr( _
        Array( _
            Array(), _
            Array(1086, 1076, 1080, 1085, 32), _
            Array(1076, 1074, 1072, 32), _
            Array(1090, 1088, 1080, 32), _
            Array(1095, 1086, 1090, 1080, 1088, 1080, 32), _
            Array(1087, 39, 1103, 1090, 1100, 32), _
            Array(1096, 1110, 1089, 1090, 1100, 32), _
            Array(1089, 1110, 1084, 32), _
            Array(1074, 1110, 1089, 1110, 1084, 32), _
            Array(1076, 1077, 1074, 39, 1103, 1090, 1100, 32), _
            Array(), _
            Array(1086, 1076, 1085, 1072, 32), _
            Array(1076, 1074, 1110, 32) _
        ))
End If



If IsEmpty(Trazr(0)) Then

'razrR = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "рубль ", "рубля ", "рублей ")
'razrD = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "доллар ", "доллара ", "долларов ")
'razrE = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "евро ", "евро ", "евро ")
'razrE = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "гривна ", "гривны ", "гривен ")
    
    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 = razrR
    razrD(UBound(razrD) - 2) = UniCodeToStr(Array(Array(1076, 1086, 1083, 1083, 1072, 1088, 32)))(0)
    razrD(UBound(razrD) - 1) = UniCodeToStr(Array(Array(1076, 1086, 1083, 1083, 1072, 1088, 1072, 32)))(0)
    razrD(UBound(razrD)) = UniCodeToStr(Array(Array(1076, 1086, 1083, 1083, 1072, 1088, 1086, 1074, 32)))(0)

'    "евро ", "евро ", "евро "
    razrE = razrR
    razrE(UBound(razrE) - 2) = UniCodeToStr(Array(Array(1077, 1074, 1088, 1086, 32)))(LBound(Array()))
    razrE(UBound(razrE) - 1) = razrE(UBound(razrE) - 2)
    razrE(UBound(razrE)) = razrE(UBound(razrE) - 2)

'    "гривна ", "гривны ", "гривен "
    razrH = razrR
    razrH(UBound(razrH) - 2) = UniCodeToStr(Array(Array(1075, 1088, 1080, 1074, 1085, 1072, 32)))(0)
    razrH(UBound(razrH) - 1) = UniCodeToStr(Array(Array(1075, 1088, 1080, 1074, 1085, 1099, 32)))(0)
    razrH(UBound(razrH)) = UniCodeToStr(Array(Array(1075, 1088, 1080, 1074, 1077, 1085, 32)))(0)
    Trazr(0) = Array(razrR, razrH, razrD, razrE)
'1 рубль, долар євро цент
'2 рублі долара євро центи
'5 рублів доларів євро центів

'   razr = Array("трильйон ", "трильйона ", "трильйонів ", "мільярд ", "мільярда ", "мільярдів ", "мільйон ", "мільйона ", "мільйонів ", "тисяча ", "тисячі ", "тисяч ", "рубль ", "рублі ", "рублів ")
'   razr = Array("трильйон ", "трильйона ", "трильйонів ", "мільярд ", "мільярда ", "мільярдів ", "мільйон ", "мільйона ", "мільйонів ", "тисяча ", "тисячі ", "тисяч ", "долар ", "долари ", "доларiв ")
'   razr = Array("трильйон ", "трильйона ", "трильйонів ", "мільярд ", "мільярда ", "мільярдів ", "мільйон ", "мільйона ", "мільйонів ", "тисяча ", "тисячі ", "тисяч ", "євро ", "євро ", "євро ")
'   razr = Array("трильйон ", "трильйона ", "трильйонів ", "мільярд ", "мільярда ", "мільярдів ", "мільйон ", "мільйона ", "мільйонів ", "тисяча ", "тисячі ", "тисяч ", "гривня ", "гривні ", "гривень ")
    razrR = UniCodeToStr( _
        Array( _
            Array(1090, 1088, 1080, 1083, 1100, 1081, 1086, 1085, 32), _
            Array(1090, 1088, 1080, 1083, 1100, 1081, 1086, 1085, 1072, 32), _
            Array(1090, 1088, 1080, 1083, 1100, 1081, 1086, 1085, 1110, 1074, 32), _
            Array(1084, 1110, 1083, 1100, 1103, 1088, 1076, 32), _
            Array(1084, 1110, 1083, 1100, 1103, 1088, 1076, 1072, 32), _
            Array(1084, 1110, 1083, 1100, 1103, 1088, 1076, 1110, 1074, 32), _
            Array(1084, 1110, 1083, 1100, 1081, 1086, 1085, 32), _
            Array(1084, 1110, 1083, 1100, 1081, 1086, 1085, 1072, 32), _
            Array(1084, 1110, 1083, 1100, 1081, 1086, 1085, 1110, 1074, 32), _
            Array(1090, 1080, 1089, 1103, 1095, 1072, 32), _
            Array(1090, 1080, 1089, 1103, 1095, 1110, 32), _
            Array(1090, 1080, 1089, 1103, 1095, 32), _
            Array(1088, 1091, 1073, 1083, 1100, 32), _
            Array(1088, 1091, 1073, 1083, 1110, 32), _
            Array(1088, 1091, 1073, 1083, 1110, 1074, 32) _
        ))
'    "долар ", "долара ", "доларiв "
    razrD = razrR
    razrD(UBound(razrD) - 2) = UniCodeToStr(Array(Array(1076, 1086, 1083, 1072, 1088, 32)))(0)
    razrD(UBound(razrD) - 1) = UniCodeToStr(Array(Array(1076, 1086, 1083, 1072, 1088, 1080, 32)))(0)
    razrD(UBound(razrD)) = UniCodeToStr(Array(Array(1076, 1086, 1083, 1072, 1088, 105, 1074, 32)))(0)
'    "євро ", "євро ", "євро "
    razrE = razrR
    razrE(UBound(razrE) - 2) = UniCodeToStr(Array(Array(1108, 1074, 1088, 1086, 32)))(0)
    razrE(UBound(razrE) - 1) = razrE(UBound(razrE) - 2)
    razrE(UBound(razrE)) = razrE(UBound(razrE) - 2)
'    "гривня ", "гривні ", "гривень "
    razrH = razrR
    razrH(UBound(razrH) - 2) = UniCodeToStr(Array(Array(1075, 1088, 1080, 1074, 1085, 1103, 32)))(0)
    razrH(UBound(razrH) - 1) = UniCodeToStr(Array(Array(1075, 1088, 1080, 1074, 1085, 1110, 32)))(0)
    razrH(UBound(razrH)) = UniCodeToStr(Array(Array(1075, 1088, 1080, 1074, 1077, 1085, 1100, 32)))(0)
    Trazr(1) = Array(razrR, razrH, razrD, razrE)
End If


rub = Left(Format(Amount, "000000000000000.00"), 15)
kop = Right(Format(Amount, "0.00"), 2)

If CDbl(rub) = 0 Then m = TNull(LanguageID)
For i = 1 To Len(rub) Step 3
    If Mid(rub, i, 3) <> "000" Or i = Len(rub) - 2 Then
        m = m & THundreds(LanguageID)(CInt(Mid(rub, i, 1))) & IIf(Mid(rub, i + 1, 1) = "1", TSecDec(LanguageID)(CInt(Mid(rub, i + 2, 1))), _
                Tdecades(LanguageID)(CInt(Mid(rub, i + 1, 1))) & Tunits(LanguageID)(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, Trazr(LanguageID)(CurrencyID)(i + 1), IIf(Mid(rub, i + 2, 1) = "1", Trazr(LanguageID)(CurrencyID)(i - 1), Trazr(LanguageID)(CurrencyID)(i)))
    End If
Next i
MSumProp = UCase(Left(m, 1)) & Mid(m, 2) & kop & TChangeUnit(LanguageID)(CurrencyID)(0) & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, TChangeUnit(LanguageID)(CurrencyID)(1), IIf(kop Mod 10 = 1, TChangeUnit(LanguageID)(CurrencyID)(2), TChangeUnit(LanguageID)(CurrencyID)(3)))
End Function


Function UniCodeToStr(ByRef Arr)
' Convert array of unicode code within array to array of texts values
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

Прикрепленные файлы

MSumProp_1.xlsm (33.05 КБ)

Изменено: БМВ - 22.06.2020 22:05:49

По вопросам из тем форума, личку не читаю.

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#22 21.06.2020 13:30:02 Медведь - полиглот Владимир

БМВ

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

#23

21.06.2020 17:16:19

sokol92, ну хоть не пылеглот.

Я вот думаю, что проще и компактнее ,сделать так с массивами или сделать вааще строковую константу, которую разбить, а потом преобразовать?

По вопросам из тем форума, личку не читаю.

sokol92 Пользователь Сообщений: 4861 Регистрация: 10.09.2017	#24 21.06.2020 17:50:25 Я использую для хранения текстовых литералов (скрытые) листы или свойства книги. Проблема в передаче модуля, содержащего функцию: Ваш модуль можно просто передать как текст. См. также #2. Владимир

БМВ

Модератор

Сообщений: 24801 Регистрация: 28.12.2016

Excel 2013, 2016, 2021

#25

21.06.2020 22:56:29

Владимир, все верно, если посмотреть на тот же Solver , то там на каждый язык лист. Но это для надстройки подойдет, а для условно самостоятельной функции - совершенно не подходит. Что касается вариантов- то читаемость кода конечно еще та.

По вопросам из тем форума, личку не читаю.

illianull

Пользователь

Сообщений: 21 Регистрация: 17.01.2019

#26

28.10.2020 11:50:51

Цитата
БМВ написал: Но это для надстройки подойдет

То-есть если написать функцию с буквами кириллицы и сохранит как надстройку, то при загрузке надстройки на компе с другой кодировкой проблем не будет? Или как? Вопрос в том как не морочить себе голову. А пусть этим занимается компьютер.

Читают тему