Алексей Гладкий - Excel. Трюки и эффекты

End If

Next

Next

' Отображение количества мин

Target.Value = intMinesAround

End If

End Sub

Код, который должен находиться в стандартном модуле, выглядит следующим образом (листинг 5.3).

Sub NewGame()

' Начало новой игры

' Подготовим поле для игры

InitGame

Dim intRow As Integer, intCol As Integer

Dim intMinesCount As Integer ' Количество мин

' Расставляем мины (то есть в случайные ячейки помещаем _

значения "*" и делаем цвет шрифта таким же, как цвет _

фона этих ячеек)

For intMinesCount = 1 To 10

' Строка для мины (от 2 до 7)

intRow = Int((6 * Rnd) + 1) + 1

' Столбец для мины (от 2 до 7)

intCol = Int((6 * Rnd) + 1) + 1

' Ставим мину, если ячейка пустая

If Cells(intRow, intCol) <> "*" Then

Cells(intRow, intCol).Font.Color = _

Cells(intRow, intCol).Interior.Color

Cells(intRow, intCol).Value = "*"

Else

' В данной ячейке мина есть – продолжим поиск ячеек

intMinesCount = intMinesCount – 1

End If

Next

' Вывод информации о количестве мин в строку состояния

Application.StatusBar = "Количество мин " & intMinesCount

End Sub

Sub InitGame()

' Раскраска (оформление) листа перед началом игры

Dim intRow As Integer, intCol As Integer

' Цвет фона всех ячеек

Cells.Interior.Color = RGB(0, 200, 75)

' Цвет шрифта всех ячеек

Cells.Font.Color = RGB(0, 0, 0)

' Размер шрифта

Cells.Font.Size = 18

' Все надписи – по центру

Cells.HorizontalAlignment = xlCenter

' Всем ячейкам игрового поля назначим особый цвет

For intRow = 2 To 7

For intCol = 2 To 7

Cells(intRow, intCol).Interior.Color = RGB(200, 200,

200)

Cells(intRow, intCol).Value = ""

Next

Next

End Sub

Sub EndGame()

' Завершение игры (поражение)

Dim intRow As Integer, intCol As Integer

' Покажем все мины. Для этого сделаем цвет шрифта всех ячеек _

черным (ведь во всех ячейках с минами "*" цвет шрифта и цвет _

заливки одинаковы)

For intRow = 2 To 7

For intCol = 2 To 7

If Cells(intRow, intCol).Value = "*" Then

Cells(intRow, intCol).Font.Color = RGB(0, 0, 0)

End If

Next

Next

MsgBox «Проигрыш»

End Sub

В данном примере рабочее поле игры будет расположено в диапазоне B2:G7. Для удобства поместим под ним кнопку вызова новой игры и привяжем к ней макрос NewGame (этот макрос будет доступен в окне выбора макросов после написания кода).

На рис. 5.7 показан интерфейс созданной игры «Минное поле».

Рис. 5.7. Игра «Минное поле»

Для запуска новой игры нужно нажать кнопку Начало игры или запустить макрос NewGame. Количество спрятанных мин будет показано в строке состояния. Ячейки на минном поле удобнее выбирать с помощью мыши. При выборе пустой ячейки в ней отобразится количество мин, расположенных рядом с данной ячейкой. При выборе ячейки с миной появится окно с сообщением Проигрыш (текст сообщения можно изменять по своему усмотрению путем внесения соответствующих корректировок в код игры).

В данном разделе мы рассмотрим создание небольшой игры, которая называется «Угадай животное». Смысл ее заключается в том, что пользователь загадывает определенное животное, а компьютер с помощью «наводящих» вопросов пытается его отгадать. Характерной особенностью игры является то, что она способна к «самообучению» – если какое-то животное не отгадано и пользователь дал подсказку, оно в дальнейшем будет угадываться.

Итак, создадим рабочую книгу, в которую входят листы MAIN и DATA. MAIN – это лист, который будет открыт по умолчанию при запуске данной книги. На нем следует расположить кнопку, с помощью которой будет запускаться игра (подробнее об этом рассказано ниже). Здесь также можно ввести произвольный текст – например, приветствие или что-то в этом роде: Вас приветствует программа «Угадай животное» и т. п.

Содержимое листа DATA показано на рис. 5.8 (обратите внимание на координаты данных – именно на такое их расположение ориентирован приведенный ниже код программы).

Рис. 5.8. Содержимое листа DATA

Приступим к созданию макроса игры. Для этого в модуле рабочего листа MAIN напишем код, который приведен в листинге 5.4.

Sub StartGame()

Dim intLastRow As Integer ' Номер строки для вставки

записей

Dim intRow As Integer ' Номер текущей строки

Dim intYesRow As Integer ' Номер строки, из которой брать _

данные при утвердительном

ответе

Dim intNoRow As Integer ' Номер строки, из которой

брать _ данные при отрицательном ответе

Dim strText As String ' Строка с вопросом или названием _ животного

Dim strNewName As String ' Строка с названием нового

животного