Шустрый
Профиль
Группа: Участник
Сообщений: 75
Регистрация: 28.4.2008
Где: Красноярск
Репутация: 2 Всего: 2
|
инет шерстил там действительно их 999 миллиардов взял чьи то наработки и добавил свои функции теперь: макрос записи числа прописью от 0 до 999 миллиардов с мантисой 4 разряда после запятойпример: 0,8765 (ноль целых восемь тысяч семьсот шестьдесят пять десятитысячных) Внимание!!! в силу того что программирую на VBA только 30 часов возможны баги и прочие сюрпризы Код | Public Часть(32) As String
Function ЧислоМантисаПрописью(nValue As Currency) As String Dim nValue2 As Currency nValue2 = nValue Dim temp As String If (nValue >= 1) And (nValue < 2) Then temp = " целая " Else: temp = " целых " End If ЧислоМантисаПрописью = ЧислоПрописью(nValue, Falsh) & temp & МантисаПрописью(nValue2) End Function
Function МантисаПрописью(Число As Currency) As String
If Число = 0 Then МантисаПрописью = "" End If If Число < 0 Then Число = Число * (-1) End If Dim Мантиса, Длина As Integer Мантиса = (Число - Fix(Число)) * 10000 Длина = Len(Мантиса) Dim Окончание As String Do While ((Мантиса Mod 10) = 0) And (Длина > 0) Мантиса = Мантиса \ 10 Длина = Длина - 1 Loop Select Case Длина Case 0 МантисаПрописью = "" Case 1 If Мантиса = 1 Then Оконьчание = "десятая" Else: Оконьчание = "десятых" End If Case 2 If Мантиса = 1 Then Оконьчание = "сотая" Else: Оконьчание = "сотых" End If Case 3 If Мантиса = 1 Then Оконьчание = "тысячная" Else: Оконьчание = "тысячных" End If Case 4 If Мантиса = 1 Then Оконьчание = "десятитысячная" Else: Оконьчание = "десятитысячных" End If End Select МантисаПрописью = ЧислоПрописью(Мантиса, False) & Оконьчание End Function Function ЧислоПрописью(Число, Optional МужскойРод = True) As String ' Присвоение значений массиву частей
Часть(1) = "оди": Часть(2) = "два" Часть(3) = "три": Часть(4) = "четыр" Часть(5) = "пят": Часть(6) = "шест" Часть(7) = "сем": Часть(8) = "восем" Часть(9) = "девят": Часть(10) = "н" Часть(11) = "е": Часть(12) = "ь" Часть(13) = "надцать": Часть(14) = "дцать" Часть(15) = "сорок": Часть(16) = "девяно" Часть(17) = "сто": Часть(18) = "две" Часть(19) = "сти": Часть(20) = "сот" Часть(21) = "одна": Часть(22) = "тысяч" Часть(23) = "а": Часть(24) = "и" Часть(25) = "миллион": Часть(26) = "ов" Часть(27) = " ": Часть(28) = "": Часть(29) = "десят": Часть(30) = "ста" Часть(31) = "миллиард": Часть(32) = "ноль " ' Временные переменные вначале сбрасываются Тысячи = Ложь: Миллионы = Ложь Миллиарды = Ложь: ВторойДесяток = Ложь ' Отбрасываем дробную часть, если она есть Число = Fix(Число) ' Определяем длину исходного числа Длина = Len(Число) ' Цикл по всем цифрам числа, начиная с крайней ' левой до крайней правой For Позиция = Длина To 1 Step -1 ' Добавляются очередные слова, описывающие ' текущую цифру ЧислоПрописью = ЧислоПрописью + _ ЦифраСтрокой(Mid(Число, _ Длина - Позиция + 1, 1), _ Позиция, МужскойРод) Next Позиция ' Алгоритм возвращает пустую строку при ' нулевом аргументе. Исправим это If ЧислоПрописью = "" Then ЧислоПрописью = Часть(32) End If
End Function ' ' Составление слов из частей по очередной ' цифре числа и по предистории работы ' ' Функция доступна только в текущем модуле ' Private Function ЦифраСтрокой(Цифра, Место, Род) As String ' Если сотни или десятки миллиардов, то ' запомнить об этом для будущего If (Цифра <> 0) And ((Место = 11) Or _ (Место = 12)) Then Миллиарды = Истина End If ' Если сотни или десятки миллионов, то ' запомнить об этом для будущего If (Цифра <> 0) And ((Место = 8) Or _ (Место = 9)) Then Миллионы = Истина End If ' Если сотни или десятки тысяч, то ' запомнить об этом для будущего If (Цифра <> 0) And ((Место = 5) Or _ (Место = 6)) Then Тысячи = Истина End If ' Если предыдущая цифра была единица ' в пеле десятков, то выбираем If ВторойДесяток Then Select Case Цифра ' пишем "десять " Case 0 ЦифраСтрокой = Часть(29) + Часть(12) + _ Часть(27) ' пишем "одиннадцать " Case 1 ЦифраСтрокой = Часть(1) + Часть(10) + _ Часть(13) + Часть(27) ' пишем "двенадцать " Case 2 ЦифраСтрокой = Часть(18) + Часть(13) + _ Часть(27) ' в остальных случаях пишем название цифры ' плюс "надцать " Case Else ЦифраСтрокой = Часть(Цифра) + Часть(13) + _ Часть(27) End Select ' Добавляем название разрядов Select Case Место Case 4 ' добавляем "тысяч " ЦифраСтрокой = ЦифраСтрокой + Часть(22) + _ Часть(27) ' добавляем "миллионов " Case 7 ЦифраСтрокой = ЦифраСтрокой + Часть(25) + _ Часть(26) + Часть(27) ' добавляем "миллиардов " Case 10 ЦифраСтрокой = ЦифраСтрокой + Часть(31) + _ Часть(26) + Часть(27) End Select ' Сбрасываем значения, так как переходим к ' предыдущим разрядам ВторойДесяток = Ложь: Миллионы = Ложь Миллиарды = Ложь: Тысячи = Ложь ' Во всех остальных случаях, то есть ' не для описания чисел второго десятка Else ' Определяем название десятков If (Место = 2) Or (Место = 5) Or _ (Место = 8) Or (Место = 11) Then Select Case Цифра ' Запоминаем про второй десяток для ' подстановки при следующем входе Case 1 ВторойДесяток = Истина ' пишем "двадцать" или "тридцать" Case 2, 3 ЦифраСтрокой = Часть(Цифра) + Часть(14) + _ Часть(27) ' пишем "сорок " Case 4 ЦифраСтрокой = Часть(15) + Часть(27) ' пишем "девяносто " Case 9 ЦифраСтрокой = Часть(16) + Часть(17) + _ Часть(27) ' в остальных случаях пишем название цифры ' плюс "десят " Case 5, 6, 7, 8 ЦифраСтрокой = Часть(Цифра) + Часть(12) + _ Часть(29) + Часть(27) End Select End If ' Определяем названия сотен If (Место = 3) Or (Место = 6) Or _ (Место = 9) Or (Место = 12) Then Select Case Цифра ' пишем "сто " Case 1 ЦифраСтрокой = Часть(17) + Часть(27) ' пишем "двести " Case 2 ЦифраСтрокой = Часть(18) + Часть(19) + _ Часть(27) ' пишем "триста " Case 3 ЦифраСтрокой = Часть(3) + Часть(30) + _ Часть(27) ' пишем "четыреста " Case 4 ЦифраСтрокой = Часть(4) + Часть(11) + _ Часть(30) + Часть(27) ' в остальных случаях пишем название цифры ' плюс "сот " Case 5, 6, 7, 8, 9 ЦифраСтрокой = Часть(Цифра) + Часть(12) + _ Часть(20) + Часть(27) End Select End If ' Определяем названия единиц If (Место = 1) Or (Место = 4) Or _ (Место = 7) Or (Место = 10) Then Select Case Цифра ' пишем "один " или "одна " Case 1 If (Род) Then ЦифраСтрокой = Часть(1) + Часть(10) + _ Часть(27) Else ЦифраСтрокой = Часть(21) + Часть(27) End If ' пишем "два " или "две " Case 2 If (Род) Then ЦифраСтрокой = Часть(Цифра) + Часть(27) Else ЦифраСтрокой = Часть(18) + Часть(27) End If ' пишем "три " Case 3 ЦифраСтрокой = Часть(Цифра) + Часть(27) ' пишем "четыре " Case 4 ЦифраСтрокой = Часть(4) + Часть(11) + _ Часть(27) ' в остальных случаях пишем название цифры Case 5, 6, 7, 8, 9 ЦифраСтрокой = Часть(Цифра) + Часть(12) + _ Часть(27) End Select ' Определяем названия тысяч If Место = 4 Then Select Case Цифра ' пишем "тысяч " только в том случае, если ' хотя бы в одном разряде тысяч есть не нулевое ' значение Case 0 If Тысячи Then ЦифраСтрокой = Часть(22) + Часть(27) End If ' пишем "одна тысяча " Case 1 ЦифраСтрокой = Часть(21) + Часть(27) + _ Часть(22) + Часть(23) + Часть(27) ' пишем "две тысячи " Case 2 ЦифраСтрокой = Часть(18) + Часть(27) + _ Часть(22) + Часть(24) + Часть(27) ' добавляем "тысячи " Case 3, 4 ЦифраСтрокой = ЦифраСтрокой + Часть(22) + _ Часть(24) + Часть(27) ' в остальных случаях добавляем "тысяч " Case 5, 6, 7, 8, 9 ЦифраСтрокой = ЦифраСтрокой + Часть(22) + _ Часть(27) End Select ' Сбрасываем значения тысяч, так как ' переходим к предыдущим разрядам Тысячи = Ложь End If ' Определяем названия миллионов If Место = 7 Then Select Case Цифра ' пишем "миллионов " только в том случае, ' если хотя бы в одном разряде миллионов ' есть не нулевое значение Case 0 If Миллионы Then ЦифраСтрокой = Часть(25) + Часть(26) + _ Часть(27) End If ' добавляем "миллион " Case 1 ЦифраСтрокой = ЦифраСтрокой + Часть(25) + _ Часть(27) ' добавляем "миллиона " Case 2, 3, 4 ЦифраСтрокой = ЦифраСтрокой + Часть(25) + _ Часть(23) + Часть(27) ' добавляем "миллионов " Case 5, 6, 7, 8, 9 ЦифраСтрокой = ЦифраСтрокой + Часть(25) + _ Часть(26) + Часть(27) End Select ' Сбрасываем значения миллионов, так как ' переходим к предыдущим разрядам Миллионы = Ложь End If ' Определяем названия миллиардов If Место = 10 Then Select Case Цифра ' пишем "миллиардов " только в том случае, ' если хотя бы в одном разряде миллиардов ' есть не нулевое значение Case 0 If Миллиарды Then ЦифраСтрокой = Часть(31) + Часть(26) + _ Часть(27) End If ' добавляем "миллиард " Case 1 ЦифраСтрокой = ЦифраСтрокой + Часть(31) + _ Часть(27) ' добавляем "миллиарда " Case 2, 3, 4 ЦифраСтрокой = ЦифраСтрокой + Часть(31) + _ Часть(23) + Часть(27) ' добавляем "миллиардов " Case 5, 6, 7, 8, 9 ЦифраСтрокой = ЦифраСтрокой + Часть(31) + _ Часть(26) + Часть(27) End Select ' Сбрасываем значения миллиардов, так как ' переходим к предыдущим разрядам Миллиарды = Ложь End If End If End If End Function
|
Тема закрыта всем спасибо!
|