Однажды, мне захотелось попробовать сделать элементарную игру «Сапер» в Excel на VBA.
Для тех, кто не знает, расскажу правила игры: есть квадратное поле, которое состоит из ячеек, например 20х20. В этих ячейках расположено определенное количество мин (пусть будет 40). Все ячейки скрыты и игрок не знает, где эти мины спрятаны. Игрок пошагово открывает ячейку за ячейкой, пытаясь не попасть на мину. Когда игрок нажимает на пустую ячейку, она открывается и открывается некоторая область пустых ячеек вокруг нее. Данная пустая область ограничена ячейками, в которой содержатся цифры — цифра в ячейке показывает сколько мин расположено вокруг нее:
Игра завершается тогда, когда открыты все ячейки, кроме тех, в которых содержатся мины — то есть в нашем случае (20х20-40) = 360 ячеек.
Для реализации этой задумки сначала был составлен алгоритм:
- Создать поле из ячеек
- Расположить мины на поле
- Расположить цифры на поле, показывающее количество мин вокруг
- Скрыть все поле другими цветами
- Создать события по нажатию на ячейку: если пустая, с цифрой, с миной
Также был составлен список проблем или недоработок, которые были найдены уже после написания кода:
- Установка флажка на ячейку, по нажатию правой кнопки отсутствует (некоторые люди ставят флажки на тех местах, где по их мнению может быть мина, но они не уверены на 100%).
- В оригинальной игре «Сапер» на Windows, при первом открытии ячейки нельзя попасть на мину: сначала игрок нажимает на ячейку, а затем генерируется поле, где нажатая ячейка НЕ является миной, а потом уже идет полноценная игра. На момент написания кода я этого не учел, поэтому с некоторой вероятностью первым кликом можно попасть на мину. Пока писал данный пункт — понял, как это реализовать, но решил, что переделывать уже не буду.
- Нет уведомлении об успешном «разминировании» всего поля. Добавлю это спустя некоторое время: в теории это не очень сложно, но, вероятно, это немного замедлит скорость выполнения всех макросов.
- Также в оригинальной игре есть возможность открыть все скрытые ячейки вокруг цифры, при условии, что все мины вокруг нее уже открыты — нужно было нажать на цифру левой кнопкой при зажатой правой. Функция довольно полезная, но на VBA реализовать ее мне не удалось.
Итак, «Сапер»:
Наш первый пункт — создать поле из ячеек. В Excel с этим не может возникнуть никаких проблем, ведь лист Excel по своей сути и есть набор ячеек. Единственное, что нам нужно сделать — определиться, какого размера будет наш «игровой квадрат», нарисовать границы и сделать ширину ячеек равной ее высоте. В конечном итоге, наше поле будет выглядеть так (поле 20х20):
Пункт второй: необходимо в нашей игре «Сапер» расположить на поле все мины. С этим пунктом также не должно возникнуть никаких проблем — все просто и элементарно. Нужно в случайных местах нашего поля расставить необходимое нам количество мин. Для этого пишем нужный нам код:
Sub mines() Dim mines_count As Integer mines_count = 0 Do While (mines_count <= 40) 'наше количество мин Randomize i = Int((20 * Rnd) + 2) 'рандомное определение строки для мины j = Int((20 * Rnd) + 2) 'рандомное определение столбца для мины If Sheets("Game").Cells(i, j) = "" Then 'если в ячейке ничего нет Sheets("Game").Cells(i, j) = "Б" '"ставим" в эту ячейку Бомбу Sheets("Game").Cells(i, j).Font.Bold = True 'и устанавливаем жирный шрифт для бомбы mines_count = mines_count + 1 'увеличиваем счетчик бомб на 1 End If Loop 'следующая итерация цикла End Sub
В данном макросе мы заполняем поле минами через цикл «While» (пока выполняется условие) — он работает до тех пор, пока на нашем поле не будет нужного нам количества мин (в данном примере — 40). Мы «рандомно» определяем строку, в которой будет находиться мина, затем так же «рандомно» определяем столбец для мины. Если в ячейке ничего нет — заполняем ее буквой «Б» (это означает, что там бомба, то есть мина) и увеличиваем счетчик мин на 1. Если в данном месте уже есть мина — ничего не делаем. И когда счетчик мин будет равен 40 — выполнение макроса завершится:
Пункт третий: необходимо в ячейках разместить цифры, которые будут показывать количество мин вокруг. Ниже представлен код для выполнения данного пункта:
Sub mines_count() For i = 2 To 21 'запускаем цикл по каждой ячейки нашего минного поля For j = 2 To 21 'столбцы и строки Count = 0 'счетчик мин равный нулю If (Sheets("Game").Cells(i, j) = "") Then 'проверяем ячейки вокруг искомой For x = i - 1 To i + 1 For y = j - 1 To j + 1 'если вокруг искомой ячейки есть мина - наращиваем счетчик If ((Sheets("Game").Cells(x, y) = "Б") And (x <> 0) And (y <> 0)) Then Count = Count + 1: Next y Next x If Count <> 0 Then Sheets("Game").Cells(i, j) = Count 'если счетчик не равен нулю - ставим цифру в ячейку End If Next j Next i End Sub
В этом макросе мы проверяем каждую ячейку нашего минного поля, перебирая двумя циклами строки и столбцы. Мы считаем, сколько мин вокруг ячейки и вписываем в нее их количество. Если же мин вокруг ячейки нет — оставляем ее пустой.
Пункт четвертый: скрыть все мины и цифры. Это максимально просто: закрашиваем весь фон игрового диапазона новым цветом и точно таким же цветом окрашиваем шрифт мин и цифр, тем самым маскируя все поле:
Sub painting() Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Interior.Color = RGB(231, 230, 230) 'заливка фона Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Font.Color = RGB(231, 230, 230) 'изменение цвета шрифта End Sub
Все, поле игры «Сапер» на листе Excel готово. Теперь приступаем к самому главному!
Пункт пятый: события по нажатию на ячейку. Возможно, для кого-то данный пункт покажется сложным для восприятия, но я постараюсь рассказать все максимально просто.
Для его реализации составим подробный алгоритм:
- Отследить «выделение ячейки» и запустить определенный код в зависимости от ее содержимого
- Если ячейка равна «Б» — вывести сообщение о проигрыше и открыть все поле
- Если ячейка равна цифре — отобразить данную цифру, изменив ее цвет на черный
- Если ячейка пустая — запустить код по открытию прилежащей пустой области, ограниченной цифрами с количеством мин
- Если ячейка не относится к игровому полю — не делать ничего
Подробно разберем каждый из этих пунктов.
Сначала — отслеживание «выделения ячейки» . Отслеживать выделение ячейки в Excel можно с помощью стандартного события «Worksheet_SelectionChange«. Код для данного события вписывается в нужный нам лист и выполняется каждый раз когда мы будем выделять какую-нибудь ячейку на этом листе:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub 'если выделено несколько ячеек - игнорируем 'если выделенная ячейка принадлежит игровому полю игры Сапер - запускаем обработку If Not Application.Intersect(Range(Cells(2, 2), Cells(21, 21)), Target) Is Nothing Then table_click (Target) 'запуск макроса обработки End If End Sub
В данном коде есть две проверки.
- Первая — количество выделенных ячеек. По правилам игры, мы должны щелкнуть на одну ячейку, потом на другую, третью и так далее. Мы не можем нажать сразу на несколько. Поэтому и в Excel, чтобы «случайно» не нажать на несколько ячеек, т.е. в нашем случае, чтобы случайно их не выделить — добавляем ограничение: если количество выделенных ячеек больше 1 — ничего не выполняем, выходим из процедуры.
- Вторая — проверяем принадлежность выделенной ячейки нашему игровому полю. Если ячейка не имеет никакого отношения к нему — не делаем ничего, в противном случае запускаем обработку ячейки с помощью макроса table_click (target), где target — наша выделенная ячейка. Код макроса table_click:
Sub table_click(a) If (a = "Б") Then 'если ячейка содержит "Б" - игра проиграна Selection.Interior.Color = RGB(255, 255, 255) 'фон выделенной ячейки становится белым Selection.Font.Color = RGB(0, 0, 0) 'цвет шрифта бомбы - черным MsgBox "Подрыв! Игра окончена!", vbCritical + vbOKOnly, "Booooom!" 'выводим сообщение Boom Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Interior.Color = RGB(255, 255, 255) 'а затем все поле делаем белым Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Font.Color = RGB(0, 0, 0) 'и цвет шрифта на всем поле - черным (чтобы видеть всю картину) End If If (a >= 1) Then 'если выделенная ячейка содержит цифру Selection.Interior.Color = RGB(255, 255, 255) 'меняем цвет шрифт выделенной ячейки на черный Selection.Font.Color = RGB(0, 0, 0) 'а фон выделенной ячейки на белый End If If (a = "") Then prepare 'включение кода оптимизации free_space Selection.Row, Selection.Column 'запуск рекурсии начиная с выделенной ячейки (где Selection.Row - ее строка, Selection.Column - столбец) white 'раскрытие ячеек с цифрами вокруг открытой пустой области ended 'выключение кода оптимизации End If End Sub
Если содержимое ячейки равно «Б» — фон ячейки становится белым, шрифт черным. Выводим сообщение о проигрыше и фон всего поля окрашиваем белым (то есть все поле открывается).
Если содержимое равно 1 или больше — фон ячейки также становится белым, а шрифт черным, то есть мы просто «открываем» ячейку с миной.
Если содержимое ячейки равно «», то есть в ней нет ничего, запускаем целый набор макросов:
Включение кода оптимизации — данный код взят отсюда. При запуске деактивируются некоторые опции Excel, которые негативно влияют на быстродействие.
Public Sub Prepare() Application.ScreenUpdating = False 'отключение обновления экрана Application.Calculation = xlCalculationManual 'отключение автоматического пересчета формул Application.EnableEvents = False 'отключение обработки событий ActiveSheet.DisplayPageBreaks = False 'отключить отображение разрывов страниц Application.DisplayStatusBar = False 'отключить статусную строку в Excel Application.DisplayAlerts = False 'отключить отображение ошибок и предупреждений End Sub
Успешно используется мной во всех проектах и значительно сокращает время работы макросов при работе с большими объемами данных — рекомендую использовать данный код почаще, но старайтесь не забывать его «деактивировать».
Запуск рекурсии по раскрытию пустых ячеек вокруг. Рекурсия — это такое явление в программировании, когда функция/макрос/процедура запускает сама себя. И запускать себя она будет до тех пор, пока не встретится ограничивающее условие (в противном случае она может зациклиться и не закончиться никогда).
Смысл данной рекурсии заключается вот в чем: есть пустая ячейка на которую мы нажали. Запускается макрос, которые проверяет на «пустоты» соседние ячейки относительно выбранной. Макрос находит такую пустую ячейку, окрашивает ее в белый цвет и запускает сам себя же, только теперь уже относительно этой пустой ячейки. И выполняться он будет до тех пор, пока либо не упрется в границы игрового поля, либо если вокруг пустой ячейки не останется других пустых.
Sub free_space(n, m) On Error GoTo new_recur 'при ошибке запускается заново. Не знаю, как это работает, но ошибка при повторном запуске пропадает For i = n - 1 To n + 1 For j = m - 1 To m + 1 If (Cells(i, j) = "") And (Cells(i, j).Interior.Color = RGB(231, 230, 230)) Then 'если ячейка пустая и закрашенная (то есть принадлежит игровому полю) Cells(i, j).Interior.Color = RGB(255, 255, 255) 'обесцвечиваем ее free_space i, j 'и запускаем этот же макрос относительно нее End If Next j Next i GoTo continue new_recur: free_space n, m continue: End Sub
И если мы нажали на пустую ячейку — после выполнения данного макроса откроется вся пустая область вокруг нее.
Отображение цифр с количеством мин. Естественно, вокруг открытой области надо отобразить цифры, которые «формируют» эту область, чтобы можно было дальше играть. Для этого мы запускаем макрос white, суть которого проста: перебираем все ячейки нашего игрового поля и, если ячейка пустая и уже открытая — открываем ячейки вокруг нее, изменяя цвет фона на белый, а цвет шрифта в ячейке на черный.
Sub white() For i = 2 To 21 For j = 2 To 21 If (Cells(i, j).Interior.Color = RGB(255, 255, 255)) And (Cells(i, j).Value = "") Then For x = i - 1 To i + 1 For y = j - 1 To j + 1 Cells(x, y).Interior.Color = RGB(255, 255, 255) Cells(x, y).Font.Color = RGB(0, 0, 0) Next y Next x End If Next j Next i End Sub
Выключение кода оптимизации. Активируем опции Excel, которые мы выключили перед выполнением предыдущих макросов:
Public Sub ended() Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True 'ActiveSheet.DisplayPageBreaks = True 'Разрывы страниц для печати можно не возвращать - они тормозят работу в любом случае и не особо нужны Application.DisplayStatusBar = True Application.DisplayAlerts = True End Sub
В целом, работа по созданию игры «Сапер» завершена!
В моем примере также добавлена кнопка, которая запускает макрос full_game(), который полностью формирует поле для игры — ставит мины и цифры и закрашивает их шрифт и фон одинаковыми цветами. Также в ней запускается вышеупомянутый макрос оптимизации, для сокращения времени работы макросов.
Sub full_game() prepare 'включение кода оптимизации clearing_table 'очистка поля mines 'расстановка мин mines_count 'количество мин вокруг painting 'заливка ended 'отключение кода оптимизации End Sub
При добавлении каких-либо доработок типа «исключение взрыва при открытии первой ячейки» или «уведомление о победе» будет сообщено дополнительно.
Здравствуйте! А можно такого сапера сделать не на ячейках экселя а на форме vba? Спасибо.
Добрый день!
Да, можно.
Сам пробовал, получилось, но надо переделать для более «правильной» работы. Как переделаю — выложу.
Принцип построения поля там такой же, как в этой статье, но вместо ячеек использовал 400 кнопок CommandButton и под них создал модуль классов, который отслеживает нажатия.