При нажатии кнопки Новый кроссворд удаляется все содержимое документа, после чего можно приступать к составлению нового кроссворда.
Рис. 5.6. Готовая сетка кроссворда
Игра «Минное поле»
Пользователям 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)