Пишем прописью
Хочу предложить вашему вниманию еще одну программу. В своей повседневной работе я сталкиваюсь с необходимостью написания чисел прописью. Представьте, когда на стандартной странице имеется пять-шесть чисел типа 15600895000 или 273659, которые надо сопроводить прописью. Попробуйте ради интереса. Облегчить эту задачу можно при помощи такого макроса:
Глобальные переменные
Dim Сумма As Currency
Dim Остаток As Currenc
Sub Пропись()
'
' Пропись Макрос
'
On Error Resume Next
Dim СуммаЦифрами As Currency
СуммаЦифрами = Selection.Text
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.TypeText Text:=СуммаПрописью(СуммаЦифрами)
End Sub
Function Единицы(Разряд As Currency, Род As String) As String
Select Case Разряд
Case 1
If Род = "Мужской" Then
Единицы = "один "
Else
Единицы = "одна "
End If
Case 2
If Род = "Мужской" Then
Единицы = "два "
Else
Единицы = "две "
End If
Case 3
Единицы = "три "
Case 4
Единицы = "четыре "
Case 5
Единицы = "пять "
Case 6
Единицы = "шесть "
Case 7
Единицы = "семь "
Case 8
Единицы = "восемь "
Case 9
Единицы = "девять "
Case 10
Единицы = "десять "
Case 11
Единицы = "одиннадцать "
Case 12
Единицы = "двенадцать "
Case 13
Единицы = "тринадцать "
Case 14
Единицы = "четырнадцать "
Case 15
Единицы = "пятнадцать "
Case 16
Единицы = "шестнадцать "
Case 17
Единицы = "семнадцать "
Case 18
Единицы = "восемнадцать "
Case 19
Единицы = "девятнадцать "
End Select
End Function
Function Десятки(Разряд As Currency) As String
Select Case Разряд
Case 2
Десятки = "двадцать "
Case 3
Десятки = "тридцать "
Case 4
Десятки = "сорок "
Case 5
Десятки = "пятьдесят "
Case 6
Десятки = "шестьдесят "
Case 7
Десятки = "семьдесят "
Case 8
Десятки = "восемьдесят "
Case 9
Десятки = "девяносто "
End Select
End Function
Function Сотни(Разряд As Currency) As String
Select Case Разряд
Case 1
Сотни = "сто "
Case 2
Сотни = "двести "
Case 3
Сотни = "триста "
Case 4
Сотни = "четыреста "
Case 5
Сотни = "пятьсот "
Case 6
Сотни = "шестьсот "
Case 7
Сотни = "семьсот "
Case 8
Сотни = "восемьсот "
Case 9
Сотни = "девятьсот "
End Select
End Function
Function Тысячи(Разряд As Currency) As String
If Разряд = 1 Then
Тысячи = "тысяча "
ElseIf Разряд > 1 And Разряд < 5 Then
Тысячи = "тысячи "
Else
Тысячи = "тысяч "
End If
End Function
Function Миллионы(Разряд As Currency) As String
If Разряд = 1 Then
Миллионы = "миллион "
ElseIf Разряд > 1 And Разряд < 5 Then
Миллионы = "миллиона "
Else
Миллионы = "миллионов "
End If
End Function
Function Миллиарды(Разряд As Currency) As String
If Разряд = 1 Then
Миллиарды = "миллиард "
ElseIf Разряд > 1 And Разряд < 5 Then
Миллиарды = "миллиарда "
Else
Миллиарды = "миллиардов "
End If
End Function
Function СуммаПрописью(СуммаЦифрами As Currency) As String
Dim Группа As Currency, Разряд As Currency, Длина As Currency
Dim Пропись As String
Сумма = СуммаЦифрами
Остаток = Сумма
Группа = Int(Остаток / 1000000000)
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100 * 1000000000
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10 * 1000000000
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Мужской")
Остаток = Остаток — Разряд * 1000000000
Пропись = Пропись & Миллиарды(Разряд)
End If
' ***************************************
Группа = Int(Остаток / 1000000)
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100 * 1000000
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10 * 1000000
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Мужской")
Остаток = Остаток — Разряд * 1000000
Пропись = Пропись & Миллионы(Разряд)
End If
Группа = Int(Остаток / 1000)
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100 * 1000
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10 * 1000
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Женский")
Остаток = Остаток — Разряд * 1000
Пропись = Пропись & Тысячи(Разряд)
End If
Группа = Остаток
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Мужской")
Остаток = Остаток — Разряд
End If
Длина = Len(Пропись)
If IsNull(Длина) Then
Exit Function
End If
Пропись = UCase(Mid(Пропись, 1, 1)) & (Mid(Пропись, 2, Длина — 2))
СуммаПрописью = "(" & Пропись & ") "
End Function Макрос работает с выделенным текстом, вставляя пропись после числа. Пропись пишется в круглых скобках с большой буквы. Между цифрами в числе не должно быть никаких символов, кроме пробелов. Например: для "123456" макрос вернет "(Сто двадцать три тысячи четыреста пятьдесят шесть)", для "1 2 3 4 5 6" вернется тоже самое (только выделять надо всю группу цифр). Но для "123,456" вернется только "(Сто двадцать)". Подобные группы цифр надо обработать в два этапа: сначала выделить цифры до запятой, затем - после запятой и вручную объединить результат (хотя - текст кода перед вами, программу можно усовершенствовать).
Если вы случайно зацепите при выделении не цифру или вообще выделите не цифры, то ничего не произойдет. Опять-таки пример: для "а 123456", как и для "слово" макрос не вернет никаких результатов.
Для того чтобы макрос стал доступным для вашего Word'а, можно проделать такие шаги:
1. Из меню Сервис/Макрос запустить команду Начать запись.
2. В появившейся панельке нажать кнопку Остановить запись.
3. Из меню Сервис/Макрос выбрать команду Макросы.
4. В появившемся окне выбрать Макрос1 и нажать кнопку Изменить.
5. В окне программ появившегося редактора полностью удалить текст Макрос1 и набрать текст вышеприведенных процедуры и функций.
6. Вернуться в окно и из меню Сервис запустить команду Настройка.
7. В появившемся окне выбрать закладку Команды и в Категориях выбрать Макросы. Затем в Командах выбрать макрос Пропись и отбуксировать его на панель инструментов.
И еще раз вернусь к программе преобразования текста: самым главным недостатком этой и подобной ей программ является то, что они "работают" только в рабочем поле Word'а. Так что у вас есть вполне реальная возможность дать какому-нибудь файлу имя "Ltkj dctq vjtq;bpyb" вместо "Дело всей моей жизни", и потерять его безвозвратно.
С уважением Алексей Ильченко
Глобальные переменные
Dim Сумма As Currency
Dim Остаток As Currenc
Sub Пропись()
'
' Пропись Макрос
'
On Error Resume Next
Dim СуммаЦифрами As Currency
СуммаЦифрами = Selection.Text
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.TypeText Text:=СуммаПрописью(СуммаЦифрами)
End Sub
Function Единицы(Разряд As Currency, Род As String) As String
Select Case Разряд
Case 1
If Род = "Мужской" Then
Единицы = "один "
Else
Единицы = "одна "
End If
Case 2
If Род = "Мужской" Then
Единицы = "два "
Else
Единицы = "две "
End If
Case 3
Единицы = "три "
Case 4
Единицы = "четыре "
Case 5
Единицы = "пять "
Case 6
Единицы = "шесть "
Case 7
Единицы = "семь "
Case 8
Единицы = "восемь "
Case 9
Единицы = "девять "
Case 10
Единицы = "десять "
Case 11
Единицы = "одиннадцать "
Case 12
Единицы = "двенадцать "
Case 13
Единицы = "тринадцать "
Case 14
Единицы = "четырнадцать "
Case 15
Единицы = "пятнадцать "
Case 16
Единицы = "шестнадцать "
Case 17
Единицы = "семнадцать "
Case 18
Единицы = "восемнадцать "
Case 19
Единицы = "девятнадцать "
End Select
End Function
Function Десятки(Разряд As Currency) As String
Select Case Разряд
Case 2
Десятки = "двадцать "
Case 3
Десятки = "тридцать "
Case 4
Десятки = "сорок "
Case 5
Десятки = "пятьдесят "
Case 6
Десятки = "шестьдесят "
Case 7
Десятки = "семьдесят "
Case 8
Десятки = "восемьдесят "
Case 9
Десятки = "девяносто "
End Select
End Function
Function Сотни(Разряд As Currency) As String
Select Case Разряд
Case 1
Сотни = "сто "
Case 2
Сотни = "двести "
Case 3
Сотни = "триста "
Case 4
Сотни = "четыреста "
Case 5
Сотни = "пятьсот "
Case 6
Сотни = "шестьсот "
Case 7
Сотни = "семьсот "
Case 8
Сотни = "восемьсот "
Case 9
Сотни = "девятьсот "
End Select
End Function
Function Тысячи(Разряд As Currency) As String
If Разряд = 1 Then
Тысячи = "тысяча "
ElseIf Разряд > 1 And Разряд < 5 Then
Тысячи = "тысячи "
Else
Тысячи = "тысяч "
End If
End Function
Function Миллионы(Разряд As Currency) As String
If Разряд = 1 Then
Миллионы = "миллион "
ElseIf Разряд > 1 And Разряд < 5 Then
Миллионы = "миллиона "
Else
Миллионы = "миллионов "
End If
End Function
Function Миллиарды(Разряд As Currency) As String
If Разряд = 1 Then
Миллиарды = "миллиард "
ElseIf Разряд > 1 And Разряд < 5 Then
Миллиарды = "миллиарда "
Else
Миллиарды = "миллиардов "
End If
End Function
Function СуммаПрописью(СуммаЦифрами As Currency) As String
Dim Группа As Currency, Разряд As Currency, Длина As Currency
Dim Пропись As String
Сумма = СуммаЦифрами
Остаток = Сумма
Группа = Int(Остаток / 1000000000)
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100 * 1000000000
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10 * 1000000000
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Мужской")
Остаток = Остаток — Разряд * 1000000000
Пропись = Пропись & Миллиарды(Разряд)
End If
' ***************************************
Группа = Int(Остаток / 1000000)
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100 * 1000000
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10 * 1000000
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Мужской")
Остаток = Остаток — Разряд * 1000000
Пропись = Пропись & Миллионы(Разряд)
End If
Группа = Int(Остаток / 1000)
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100 * 1000
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10 * 1000
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Женский")
Остаток = Остаток — Разряд * 1000
Пропись = Пропись & Тысячи(Разряд)
End If
Группа = Остаток
If Группа <> 0 Then
Разряд = Группа \ 100
Пропись = Пропись & Сотни(Разряд)
Остаток = Остаток — Разряд * 100
Группа = Группа — Разряд * 100
If Группа > 19 Then
Разряд = Группа \ 10
Пропись = Пропись & Десятки(Разряд)
Остаток = Остаток — Разряд * 10
Группа = Группа — Разряд * 10
End If
Разряд = Группа
Пропись = Пропись & Единицы(Разряд, "Мужской")
Остаток = Остаток — Разряд
End If
Длина = Len(Пропись)
If IsNull(Длина) Then
Exit Function
End If
Пропись = UCase(Mid(Пропись, 1, 1)) & (Mid(Пропись, 2, Длина — 2))
СуммаПрописью = "(" & Пропись & ") "
End Function Макрос работает с выделенным текстом, вставляя пропись после числа. Пропись пишется в круглых скобках с большой буквы. Между цифрами в числе не должно быть никаких символов, кроме пробелов. Например: для "123456" макрос вернет "(Сто двадцать три тысячи четыреста пятьдесят шесть)", для "1 2 3 4 5 6" вернется тоже самое (только выделять надо всю группу цифр). Но для "123,456" вернется только "(Сто двадцать)". Подобные группы цифр надо обработать в два этапа: сначала выделить цифры до запятой, затем - после запятой и вручную объединить результат (хотя - текст кода перед вами, программу можно усовершенствовать).
Если вы случайно зацепите при выделении не цифру или вообще выделите не цифры, то ничего не произойдет. Опять-таки пример: для "а 123456", как и для "слово" макрос не вернет никаких результатов.
Для того чтобы макрос стал доступным для вашего Word'а, можно проделать такие шаги:
1. Из меню Сервис/Макрос запустить команду Начать запись.
2. В появившейся панельке нажать кнопку Остановить запись.
3. Из меню Сервис/Макрос выбрать команду Макросы.
4. В появившемся окне выбрать Макрос1 и нажать кнопку Изменить.
5. В окне программ появившегося редактора полностью удалить текст Макрос1 и набрать текст вышеприведенных процедуры и функций.
6. Вернуться в окно и из меню Сервис запустить команду Настройка.
7. В появившемся окне выбрать закладку Команды и в Категориях выбрать Макросы. Затем в Командах выбрать макрос Пропись и отбуксировать его на панель инструментов.
И еще раз вернусь к программе преобразования текста: самым главным недостатком этой и подобной ей программ является то, что они "работают" только в рабочем поле Word'а. Так что у вас есть вполне реальная возможность дать какому-нибудь файлу имя "Ltkj dctq vjtq;bpyb" вместо "Дело всей моей жизни", и потерять его безвозвратно.
С уважением Алексей Ильченко
Компьютерная газета. Статья была опубликована в номере 51 за 1999 год в рубрике программирование :: разное
