Public Function ПРОПИСЬ(num) As String

' Аргументы: положительное число < 1 000 000 000 000,457

' Назначение: преобразует это число в число прописью

' с рублями и копейками

' Возвращает: строку, содержащую число прописью

' например ПРОПИСЬ(3000119,072)="три миллиона

' сто девятнадцать рублей 07 копеек"

' Вызывает: функции prop3(), prop3rub() и propkop()

If num < 0 Then

ПРОПИСЬ = "Число<0!"

Exit Function

End If

N = Int(((num - Int(num)) * 100) + 0.5)' выделить копейки и округлить

S = propkop(N) ' вызов propkop для преобразования копеек

N = Int(num) ' выделить рубли

M = N - 1000 * Int(N / 1000) ' выделить трехзначное число

If N = 0 Then ' если только копейки

ПРОПИСЬ = "Ноль рублей" + S

Exit Function

End If

S = prop3rub(M) + S ' преобразовать младшие три цифры

' и приписать рублей/рубля/рубль

' начало обработки тысяч

N = Int(num / 1000) ' отбросить три последние цифры

M = N - 1000 * Int(N / 1000) ' выделить трехзначное число тысяч

L = ""

If M > 0 Then ' вычисление склонения тысяч

Select Case (M - 10 * Int(M / 10))

Case 1

L = "тысяча "

Case 2 To 4

L = "тысячи "

Case Else

L = "тысяч "

End Select

Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14

Case 11 To 14

L = "тысяч "

End Select

S = prop3(M) + L + S ' вызов prop3 для преобразования тысяч

End If ' и дописать в переменную S

' начало обработки миллионов

N = Int(N / 1000) ' отбросить три последние цифры

M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллионов

L = ""

If M > 0 Then

Select Case (M - 10 * Int(M / 10))

Case 1

L = "миллион "

Case 2 To 4

L = "миллиона "

Case Else

L = "миллионов "

End Select

Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14

Case 11 To 14

L = "миллионов "

End Select

S = prop3(M) + L + S ' вызов prop3 для преобразования миллионов

End If ' и дописать в переменную S

' начало обработки миллиардов

N = Int(N / 1000) ' отбросить три последние цифры

M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллиардов

L = ""

If M > 0 Then

Select Case (M - 10 * Int(M / 10))

Case 1

L = "миллиард "

Case 2 To 4

L = "миллиарда "

Case Else

L = "миллиардов "

End Select

Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14

Case 11 To 14

L = "миллиардов "

End Select

S = prop3(M) + L + S ' вызов prop3 для преобразования миллиардов

End If ' и дописать в переменную S

' начало обработки триллионов

N = Int(N / 1000) ' отбросить три последние цифры

M = N - 1000 * Int(N / 1000) ' выделить трехзначное число триллионов

L = ""

If M > 0 Then

Select Case (M - 10 * Int(M / 10))

Case 1

L = "триллион "

Case 2 To 4

L = "триллиона "

Case Else

L = "триллионов "

End Select

Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14

Case 11 To 14

L = "триллионов "

End Select

S = prop3(M) + L + S ' вызов prop3 для преобразования триллионов

End If ' и дописать в переменную S

S = UCase(Mid(S, 1, 1)) + Mid(S, 2) ' первую букву сделать заглавной

ПРОПИСЬ = S ' итоговое значение S присвоить функции

End Function ' ПРОПИСЬ

 

Function prop3(N) ' основная функция преобразования

' Аргументы: трехзначное целое положительное число

' Назначение: преобразует это число в число прописью

' Возвращает: строку, содержащую число прописью

' например prop3(119)="сто девятнадцать"

' Вызов: из функции ПРОПИСЬ()

S = ""

Select Case (N - 100 * Int(N / 100)) ' выделить две последние цифры

Case 10

S = "десять "

Case 11

S = "одинадцать "

Case 12

S = "двенадцать "

Case 13

S = "тринадцать "

Case 14

S = "четырнадцать "

Case 15

S = "пятнадцать "

Case 16

S = "шестнадцать "

Case 17

S = "семнадцать "

Case 18

S = "восемнадцать "

Case 19

S = "девятнадцать "

Case Else

i = 10 * Int(N / 10)

Select Case (N - i) ' выделить цифру единицы

Case 1

S = "один "

Case 2

S = "два "

Case 3

S = "три "

Case 4

S = "четыре "

Case 5

S = "пять "

Case 6

S = "шесть "

Case 7

S = "семь "

Case 8

S = "восемь "

Case 9

S = "девять "

End Select

SS = ""

i = i / 10

Select Case (i - 10 * Int(i / 10)) ' выделить цифру десятков

Case 2

SS = "двадцать "

Case 3

SS = "тридцать "

Case 4

SS = "сорок "

Case 5

SS = "пятьдесят "

Case 6

SS = "шестьдесят "

Case 7

SS = "семьдесят "

Case 8

SS = "восемьдесят "

Case 9

SS = "девяносто "

End Select

S = SS + S

End Select

SS = ""

Select Case Int(N / 100) ' выделить цифру сотен

Case 1

SS = "сто "

Case 2

SS = "двести "

Case 3

SS = "триста "

Case 4

SS = "четыреста "

Case 5

SS = "пятьсот "

Case 6

SS = "шестьсот "

Case 7

SS = "семьсот "

Case 8

SS = "восемьсот "

Case 9

SS = "девятьсот "

End Select

S = SS + S

prop3 = S

End Function 'prop3

 

Function prop3rub(N) ' аналогична prop3()?

' Аргументы: трехзначное целое положительное число

' Назначение: аналогична prop3(), но с допиской рублей/рубля/рубль

' Возвращает: строку, содержащую число прописью

' например prop3rub(132)="сто тридцать два рубля"

' Вызов: из функции ПРОПИСЬ()

S = ""

Rub = "рублей "

Select Case (N - 100 * Int(N / 100)) ' выделить две последние цифры

Case 10

S = "десять " + Rub

Case 11

S = "одинадцать " + Rub

Case 12

S = "двенадцать " + Rub

Case 13

S = "тринадцать " + Rub

Case 14

S = "четырнадцать " + Rub

Case 15

S = "пятнадцать " + Rub

Case 16

S = "шестнадцать " + Rub

Case 17

S = "семнадцать " + Rub

Case 18

S = "восемнадцать " + Rub

Case 19

S = "девятнадцать " + Rub

Case Else

i = 10 * Int(N / 10)

Select Case (N - i) ' выделить цифру единицы

Case 0

S = Rub

Case 1

S = "один рубль "

Case 2

S = "два рубля "

Case 3

S = "три рубля "

Case 4

S = "четыре рубля "

Case 5

S = "пять " + Rub

Case 6

S = "шесть " + Rub

Case 7

S = "семь " + Rub

Case 8

S = "восемь " + Rub

Case 9

S = "девять " + Rub

End Select

SS = ""

i = i / 10

Select Case (i - 10 * Int(i / 10)) ' выделить цифру десятков

Case 2

SS = "двадцать "

Case 3

SS = "тридцать "

Case 4

SS = "сорок "

Case 5

SS = "пятьдесят "

Case 6

SS = "шестьдесят "

Case 7

SS = "семьдесят "

Case 8

SS = "восемьдесят "

Case 9

SS = "девяносто "

End Select

S = SS + S

End Select

SS = ""

Select Case Int(N / 100) ' выделить цифру сотен

Case 1

SS = "сто "

Case 2

SS = "двести "

Case 3

SS = "триста "

Case 4

SS = "четыреста "

Case 5

SS = "пятьсот "

Case 6

SS = "шестьсот "

Case 7

SS = "семьсот "

Case 8

SS = "восемьсот "

Case 9

SS = "девятьсот "

End Select

S = SS + S

prop3rub = S

End Function ' prop3rub

 

Function propkop(N)

' Аргументы: двухзначное целое положительное число

' Назначение: преобразует это число в число с допиской

' копеек/копейки/копейка

' Возвращает: строку, содержащую число прописью

' например propkop(8)="08 копеек"

' Вызов: из функции ПРОПИСЬ()

S = " копеек"

If N < 10 Or N > 19 Then

i = 10 * Int(N / 10)

Select Case (N - i) ' выделить цифру единицы

Case 1

S = " копейка"

Case 2 To 4

S = " копейки"

End Select

End If

If N > 9 Then

propkop = Str$(N) + S

Else

propkop = "0" + Mid(Str$(N), 2) + S

End If

End Function ' propkop

 

Общий алгоритм работы функции ПРОПИСЬ() следующий. Число передается в функцию через параметр num: Public Function ПРОПИСЬ(num) As String. Далее число анализируется, из него выделяются копейки, последовательно выделяются по три цифры сотен, тысяч, миллионов, миллиардов, триллионов. Обработка выделенных цифр выполняется обращением к подпрограммам – функциям prop3(), prop3rub() и propkop(). Обработанная часть числа накапливается в строковой переменной S. Ее значение присваивается функции ПРОПИСЬ() в конце программы.

В программе использованы операторы условия If…Then…Else, операторы выбора Select…Case, оператор выхода Exit, функция целая часть числа Int(), функция преобразования числа в строку Str(), функция выборки подстроки из строки Mid(), функция преобразования в заглавные буквы UCase(), логическая операция ИЛИ OR, оператор сложения строк +. Описание этих средств можно найти в справочной системе редактора VBA по клавише F1, введя для поиска строку "statements".

 

 

Приложение 2. ИГРА БЫКИ-КОРОВЫ

 

Язык Visual Basic for Applications (VBA) используется для программирования приложений Microsoft Office. Он поддерживает современные технологии программирования и содержит специфические для каждого приложения объекты, в частности Excel. На примере простой программы Быки-Коровы покажем элементы программирования в Excel.

Описание языка VBA можно найти в справочной системе Excel (клавиша F1), в разделе Сведения о программировании.

 

Смысл игры пояснен на рис. П.19. Компьютер загадывает число из 4-х цифр. Ваша задача отгадать число из 10-ти попыток. После каждой попытки компьютер выводит информацию о совпадении цифр введенного числа с загаданным. Бык (Б) означает, что цифра отгадана и она стоит в нужной позиции. Корова (К) означает, что цифра отгадана, но она стоит не в своей позиции. На рис. П.19 загаданные цифры отгаданы с 3-ей попытки: Б=4, К=0.

 

Рис. П.19

 

Кнопки для ввода цифр расположены на панели справа. Кнопка Новая игра инициирует новую игру. Кнопка Решение показывает загаданные цифры. Кнопка Сохранить позволяет сохранить протокол игры в файл, а кнопка Просмотреть – просмотреть протоколы игр в редакторе NotePad.

Ваша задача – воспроизвести эту программу на своем компьютере. Задача решается в 4 этапа:

- ввод игрового поля и панели кнопок как на рис. П.19;

- ввод текста программы в редакторе Visual Basic;

- назначение кнопкам панели макросов-подпрограмм;

- отладка и тестирование программы.

Введите игровое поле. Обратите внимание, что игровое поле размещено в диапазоне ячеек от (4:3) до(22:13) – выбран стиль ссылок R1C1 (С е рвис à П а раметры... àвкладка Общие àфлаг Стиль ссылок R 1 C1, рис. 1.5). Строки для ввода цифр идут с интервалом 2, начиная со строки 4. Колонки также идут с интервалом 2, начиная с колонки 3. Колонки 11 и 13 используются для вывода результат совпадений.

Нарисуйте панель с кнопками. Настройте изображения кнопок – щелкните правой кнопкой мыши по каждой кнопке и в окне Ф ормат объекта выполните настройки: шрифт, выравнивание по центру и пр. Рисование кнопок и назначение макросов было рассмотрено в главе 1.

Вызовите редактор Visual Basic, вставьте новый модуль и введите текст программы (рис. П.18). После ввода текста программы проверьте его на наличие синтаксических ошибок: пункт меню О т ладкаàКо м пилировать VBAProject (D ebugàCompi l e VBAProject). Исправьте ошибки строго по тексту программы, с учетом всех знаков, точного написания названий подпрограмм, переменных и операторов.

Текст программы можно скачать из Интернета по адресу www.kuprava.ru в разделе Excel. Здесь приводим полный текст программы Быки-Коровы на языке VBA с комментариями.

 

Public Row, Col As Integer ' переменные для координат игрового поля

Public Цифры(1 To 4) As Integer ' массив для загаданных цифр

 

Sub Auto_open() ' обработчик события "при открытии книги"

НоваяИгра

End Sub

 

Sub НоваяИгра() ' инициализация игры

Randomize ' загадывание 4-х разных чисел

Цифры(1) = Int(10 * Rnd) ' с помощью функции Rnd()

I = 2

Do While I <= 4

Цифры(I) = Int(10 * Rnd)

For J = 1 To I - 1

If Цифры(J) = Цифры(I) Then

I = I - 1

Exit For

End If

Next J

I = I + 1

Loop

For Row = 4 To 23 Step 1 ' очистка игрового поля

For Col = 2 To 14 Step 1

Cells(Row, Col).Value = "" ' значение ячейки - пусто

Cells(Row, Col).Font.Color = RGB(0, 0, 0) ‘ цвет символов ячейки - черный

Next Col

Next Row

For I = 1 To 10 Step 1 ' пронумеровать строки

Cells(2 + 2 * I, 2).Value = I

Next I

Row = 4 ' подготовить координаты

Col = 3 ' первой ячейки ввода

End Sub

 

Sub Кнопка0() ' подпрограммы обработки нажатий цифровых кнопок

ОбработкаЦифры (0)

End Sub

Sub Кнопка1()

ОбработкаЦифры (1)

End Sub

Sub Кнопка2()

ОбработкаЦифры (2)

End Sub

Sub Кнопка3()

ОбработкаЦифры (3)

End Sub

Sub Кнопка4()

ОбработкаЦифры (4)

End Sub

Sub Кнопка5()

ОбработкаЦифры (5)

End Sub

Sub Кнопка6()

ОбработкаЦифры (6)

End Sub

Sub Кнопка7()

ОбработкаЦифры (7)

End Sub

Sub Кнопка8()

ОбработкаЦифры (8)

End Sub

Sub Кнопка9()

ОбработкаЦифры (9)

End Sub

 

Sub ОбработкаЦифры(Цифра) ' подпрограмма записи цифры

Cells(Row, Col).Activate ' активизировать ячейку

ActiveCell.Value = Цифра ' и записать в нее цифру

If ActiveCell.Column < 9 Then ' все колонки строки заполнены?

Col = ActiveCell.Column + 2 ' нет, на следующую колонку

Else

Col = 3 ' подготовить номер колонки

Расчет ' да, расчет введенной строки

End If

End Sub

 

Sub Расчет() ' подпрограмма расчета строки

If Проверка Then ' если все цифры отгаданы, то

For I = 3 To 9 Step 2 ' покрасить их в красный цвет

Cells(Row, I).Font.Color = RGB(255, 0, 0)

Next I

Cells(Row, 11).Font.Color = RGB(255, 0, 0)

Cells(Row, 13).Font.Color = RGB(255, 0, 0)

MsgBox "Вы выиграли!",, "Быки & Коровы"

Else

If (Row = 22) Then

Решение ' проигрыш и вывод решения

Else

Row = Row + 2 ' подготовить номер следующей строки

End If

End If

End Sub

 

Function Проверка() ' подпрограмма-функция подсчета быков и коров

Dim Быки As Integer, Коровы As Integer, БылБык As Boolean

Быки = 0 ' счетчик быков

Коровы = 0 ' счетчик коров

For I = 1 To 4

БылБык = False

If Cells(Row, 1 + I * 2).Value = Цифры(I) Then

Быки = Быки + 1 ' подсчет быков

БылБык = True ' установить флаг БылБык

End If

If Not БылБык Then ' если не был бык, то

For j = 1 To 4 ' проверить I-ю цифру на корову

If I <> j And Cells(Row, 1 + j * 2).Value = Цифры(I) Then

Коровы = Коровы + 1

Exit For ' выход из внутреннего цикла, чтобы

End If ' не считать одинаковых коров

Next j

End If

Next I

Cells(Row, 11).Value = Быки ' запись быков и коров в ячейки

Cells(Row, 13).Value = Коровы

If Быки = 4 Then

Проверка = True ' 4 быка - окончание игры

Else

Проверка = False ' игра не окончена

End If

End Function

 

Sub Решение() ' подпрограмма вывода решения

Dim Число As String

Число = ""

For I = 1 To 4 ' преобразование числа в строку

Число = Число + Str(Цифры(I))

Next I

MsgBox "Вы проиграли! Загаданное число: " & Число,, "Быки & Коровы"

End Sub

 

Sub ПросмотрПротокола() ' подпрограмма кнопки Просмотреть

Dim fso ' переменная для ссылки на ActiveX элемент доступа к файлам

Set fso = CreateObject("Scripting.FileSystemObject") ' создать объект доступа к файлу

If fso.FileExists(Application.DefaultFilePath & "\BC.txt") Then ' если файл BC.txt существует,

Call Shell("C:\WINDOWS\NotePad.exe BC.txt", 1) ' то вызвать Блокнот с протоколом

End If

End Sub

 

Sub СохранитьПротокол() ' подпрограмма кнопки Сохранить

Const ForAppending = 8

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(Application.DefaultFilePath & "\BC.txt", ForAppending, True, 0)

Line = "Дата " & Str(Now()) ' вычисление и запись

f.WriteLine Line ' даты в файл протокола

Line = "Ваши числа Б К" ' запись заголовка

f.WriteLine Line ' в файл протокола

For I = 4 To 22 Step 2

Line = " " ' формирование строки чисел

k = 0

For J = 3 To 13 Step 2

Line = Line + " " + Str((Cells(I, J).Value))

k = k + 1

If k = 4 Then Line = Line + " " ' сдвиг цифр Б и К вправо

Next J

f.WriteLine Line ' запись строки в файл протокола

Next I

Line = "Загаданное число:"

For I = 1 To 4 ' формирование строки чисел

Line = Line + " " + Str(Цифры(I))

Next I

f.WriteLine Line ' запись строки в файл протокола

f.WriteLine

f.Close

End Sub

Если синтаксический контроль не дает ошибок, то можно приступать к назначению макросов кнопкам. Вернитесь в окно Excel. Поочередно, щелкая правой кнопкой мыши (пункт Назначит ь макрос…), каждой кнопке припишите макрос из списка – рис. П.20.

 

Рис. П20

 

Кнопкам 0-9 назначьте макросы Кнопка0…Кнопка9 соответственно, кнопкам Новая игра и Решение – одноименные макросы, кнопке Сохранить – макрос СохранитьПротокол(0), кнопке Просмотреть – макрос ПросмотрПротокола().

После этих действий сохраните xls-программу в файл, закройте его и выполните первую загрузку программы. По событию "открытие книги Excel" будет запущена подпрограмма Auto_open(), которая в свою очередь вызывает подпрограмму НоваяИгра(). НоваяИгра() загадывает 4 разные цифры, обновляет игровое поле и устанавливает координаты первой позиции в глобальные (Public, доступные из всех подпрограмм) переменные Row и Col. Подпрограмма НоваяИгра() также вызывается по нажатию одноименной кнопки. Применяемая здесь процедура Cells() использует R1C1-стиль обращения к ячейкам, функция RGB устанавливает цвет ячеек.

На нажатие цифровых кнопок реагируют подпрограммы Кнопка0() - Кнопка9(). Они передают соответствующую цифру в подпрограмму ОбработкаЦифры(), которая записывает цифру в нужную ячейку, по координатам (Row,Col). В подпрограмме ОбработкаЦифры() проверяется, ввел ли игрок все 4 цифры, если да, то вызывается подпрограмма Расчет().

Вся расчетная часть программы выполняется в функции Проверка(). Она выполняет 3 основных действия: вычисляет количество быков и коров, записывает их в ячейки игрового поля, возвращает значение True (Истина) при вычислении 4-х быков, иначе возвращает значение False (Ложь). Подпрограмма Расчет(), проверяющая функцию Проверка(), либо заканчивает игру с сообщением "Вы выиграли", либо переходит на ввод новой строки цифр, либо выводит сообщение "Вы проиграли! Загаданное число: хххх" в случае 10-ти неверных попыток.

Подпрограмма ПросмотрПротокола() проверяет наличие файла BC.txt в папке Excel по умолчанию (в MS Office 2000 это C:\Windows\Personal) и запускает программу блокнота NotePad.exe.

Подпрограмма СохранитьПротокол(0) открывает текстовый файл для добавления и записывает туда протокол игры в виде:

 

Описание всех незнакомых директив и операторов можно найти в справочной системе редактора VBA. Для этого достаточно выделить незнакомое слово мышью и щелкнуть по клавише F1 – будет открыта справочная система Visual Basic на нужной странице.

 

Если правильность работы программы вызывает у вас сомнения, то протестируйте ее на различных данных. Если на вашем компьютере установлен антивирус Kaspersky Anti-Virus Office Guard, то установите низкий уровень безопасности, либо отключите его: в противном кнопки Сохранить и Просмотреть будут выдавать ошибки. Программа может быть расширена по вашему усмотрению. В программе показана лишь маленькая часть возможностей программирования в Excel.