четверг, 8 сентября 2011 г.

Сумма прописью в Excell

На днях возникла необходимость автоматического преобразования чисел в текстовый вид в MS Excell. Вариант написания своего макроса душу не грел, как минимум потому, что задача явно не уникальная и все уже написано до нас. Естественно, что что поиск это предположение подтвердил, была найдена замечательная надстройка. Правда, как обычно, не обошлось без НО - народ возжелал, чтобы поддерживались не только рубли/евро/доллары, но и условные единицы. Тут уж и пришлось вложить свои пять копеек...

Для удовлетворения потребностей коллег, на основании кода автора была дописана функция, обрабатывающая суммы в УЕ. Исходный код смотрим ниже:
'
' Функция возвращает сумму прописью в условных единицах
'
Function СуммаПрописьюУЕ(УЕ)
' Вызов функции для получения числа прописью
Число = CStr(Fix(УЕ))
МужскойРод = Ложь
СуммаПрописьюУЕ = ЧислоПрописью(Число, МужскойРод)
' Строку с заглавной буквы
СуммаПрописьюУЕ = UCase(Mid(СуммаПрописьюУЕ, 1, 1)) + _
Mid(СуммаПрописьюУЕ, 2)
' Вычислить длину исходного числа
Длина = Len(Число)
' Если число только из одной цифры, добавить
' до двух (для единообразия алгоритма)
If Длина = 1 Then
Число = "0" & Число
Длина = Длина + 1
End If
' Для чисел, оканчивающихся на 1 добавляем "целая"
If Mid(Число, Длина, 1) = 1 Then
Целые = "целая"
' Для всех остальных случаев "целых"
Else
Целые = "целых"
End If
Окончание = "условных единиц"
' Считаем центы
Переменная = (УЕ - Fix(УЕ)) * 100
If (Переменная - Fix(Переменная)) > 0.5 Then
Переменная = Fix(Переменная) + 1
Else
Переменная = Fix(Переменная)
End If
Центы = CStr(Переменная)
' Окончательно формируем результат, добавляя центы
If Len(Центы) = 1 Then
Центы = "0" + Центы
End If
СуммаПрописьюУЕ = СуммаПрописьюУЕ + Целые + " и " + Центы + " "
' Для чисел, оканчивающихся на 1 добавляем "сотая"
If Mid(Центы, 2) = 1 Then
СуммаПрописьюУЕ = СуммаПрописьюУЕ + "сотая" + "" + Окончание
' Для всех остальных случаев "сотых"
Else
СуммаПрописьюУЕ = СуммаПрописьюУЕ + "сотых" + " " + Окончание
End If
End Function
 Чтобы воспользоваться результатом моих трудов, переходим на страницу автора надстройки, скачиваем ее и устанавливаем согласно инструкции. Далее, открываем в Excell редактор VisualBasic и вставляем в авторский код мою поделку, нажимаем кнопку сохранить и пользуемся результатом. Ну, а если лень совсем, то берем готовую надстройку тут

Комментариев нет:

Отправить комментарий