Пользователям Windows известно, что в комплект поставки операционной системы входит несколько игр, в том числе Сапер. Однако не многие знают, что подобную игру можно создать самостоятельно в Excel, используя механизм макросов.
Игра «Минное поле», о которой рассказывается в данном разделе, во многом аналогична стандартной игре Сапер. Для создания игры необходимо написать несколько макросов, объединенных в два кода: первый код должен быть помещен в модуль того рабочего листа, на котором предполагается разместить игру, а второй – в стандартный модуль.
В модуль рабочего листа необходимо поместить такой код (листинг 5.2).
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim intCol As Integer, intRow As Integer
Dim intMinesAround As Integer
Dim fInGameField As Boolean
' Определим, попадает ли в игровое поле выделенная ячейка
fInGameField = (Target.Row >= 2) And (Target.Row <= 7) _
And (Target.Column >= 2) And (Target.Column <= 7)
' Обрабатываем выделение ячейки
If Target.Value = "*" And fInGameField Then
' Пользователь выделил ячейку с миной – покажем мину
Target.Font.Color = RGB(0, 0, 0)
Target.Interior.Color = RGB(255, 0, 0)
' Пользователь проиграл!
EndGame
ElseIf fInGameField Then
' Пользователь выделил пустую ячейку. Оформим эту ячейку
Target.Interior.Color = RGB(0, 0, 255)
Target.Font.Color = RGB(0, 255, 0)
Target.Font.Size = 16
' Подсчитаем количество мин рядом с ячейкой (вокруг ячейки)
For intCol = Target.Column – 1 To Target.Column + 1
For intRow = Target.Row – 1 To Target.Row + 1
If Target.Worksheet.Cells(intRow, intCol).Value =
"*" _
Then
' Нашли очередную мину
intMinesAround = intMinesAround + 1
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 ' Строка с названием нового
животного
Dim strNewQuestion As String ' Строка с новым вопросом
Dim intRes As Integer
' Начало игры
MsgBox «Начнем игру. Задумайте животное.», vbOKOnly, _
«Задумайте животное»
' Определение номера ряда для вставки записей. _
intLastRow-1 – номер последнего ряда, содержащего данные
intLastRow = Worksheets(«Data»).Range(«D1»).Value + 1
' Данные в таблице идут с первого ряда
intRow = 1
Do While intRow < intLastRow
' Текст вопроса или название животного из столбца "A"
strText = Worksheets(«Data»).Cells(intRow, 1).Value
' Номер ряда, из которого брать данные при утвердительном _
ответе, берем из столбца "B"
intYesRow = Worksheets(«Data»).Cells(intRow, 2).Value
' Номер ряда, из которого брать данные при отрицательном _
ответе, берем из столбца "C"
intNoRow = Worksheets(«Data»).Cells(intRow, 3).Value
If intYesRow > 0 Then
' В строке strText содержится вопрос. Зададим его
intRes = MsgBox(strText, vbYesNo, «Вопрос»)
If intRes = vbYes Then
' Переходим по утвердительному ответу
intRow = intYesRow
Else
' Переходим по отрицательному ответу
intRow = intNoRow
End If
Else
' Альтернативы закончились. В строке strText – название _
животного. Спросим, его ли загадали
intRes = MsgBox("Это " & strText & "?", vbYesNo, «Вопрос»)
If intRes = vbYes Then
' Животное угадано
MsgBox «Угадала! Спасибо за игру!», vbOKOnly, _
«Игра завершена»
Exit Do
Else
' Животное не угадали, но данные уже занкончились. _
Нужно пополнить наши данные, чтобы отличать животное _
с названием strText от загаданного
' Ввод названия нового животного
strNewName = InputBox(«Сдаюсь. Кто это?», _
«Напечатайте название животного»)
If strNewName <> "" Then
' Ввод вопроса, по которому отличать животных
strNewQuestion = InputBox("Задайте вопрос, по " & _
«которому можно отличить '» & strNewName & _
«' от '» & strText & "'","Напечатайте вопрос")
If strNewQuestion <> "" Then
' Определение, какое из животных соответствует _
утвердительному ответу на вопрос
intRes = MsgBox(«Правильный ответ на ваш» & _
"вопрос – " & strNewName & "“", vbYesNo, _
«Какой ответ на вопрос?»)
' Добавление в таблицу названия нового животного
Worksheets(«Data»).Cells(intLastRow, 1). _
Value = strNewName
' Перемещения названия животного, которое было _
ранее, в конец таблицы
Worksheets(«Data»).Cells(intLastRow + 1, 1). _
Value = strText
' Замена названия этого животного вопросом
Worksheets(«Data»).Cells(intRow, 1). _
Value = strNewQuestion
' Корректировка номеров строк для перехода _
в зависимости от того, какое животное является _
правильным ответом на введенный пользователем
вопрос
If intRes = vbYes Then
' Новое животное – правильный ответ