Яндекс.Метрика

    Песочница

    Применение VBA к решению ряда задач

    Думаю, все знают о возможности создания макросов в Microsoft Excel. С его помощью, если требуется периодическое выполнение задачи в Excel, можно автоматизировать задачу. То, что я сейчас напишу будет очевидно многим. Но, если кому-нибудь принесёт пользу, я буду рад.
    Итак, самый простой способ создания макроса – запись. Во время этой операции требуется только двигать мышью и нажимать нужные клавиши, задавая порядок выполнения команд. При воспроизведении макроса выполняются все действия, которые были совершены при записи. Но, есть и другой способ. В Microsoft Excel есть возможность написания макроса на Visual Basic. Я решил с его помощью создать Excel документ с всем известной игрой «Сапёр». Ниже представлен текст программы.
    Этот код я поместил в модуль рабочего листа.
    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


    Этот код я поместил в стандартный модуль.
    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



    Вот, собственно, результат:
    image
    Ход игры
    image
    Реакция на мину

    Где можно это использовать?
    Использовать это можно даже на своём веб-сайте, личном блоге и т.д.
    Как? С помощью преобразования таблицы Excel в HTML-формат.
    Эта задача очень актуальна при необходимости оперативного размещения на сайте самой свежей информации. Это можно сделать с помощью специально разработанной процедуры преобразования таблицы Excel в HTML-формат. Результатом преобразования будет готовый HTML-файл, сохранённый по указанному пути. Я смог бы здесь вставить код, для того чтобы это сделать. Но, к сожалению, хабрахабр, по неизвестным мне причинам, не хочет публиковать его до конца. Возможно, сделаю это в следующий раз (если он будет).

    Благодаря высокой степени интеграции в приложения, язык VBA обеспечивает программисту возможность легко использовать существующие возможности Microsoft Office для решения ряда специфических задач. Не менее легко VBA позволяет добавлять в приложения этого пакета новые возможности, увеличивая их функциональность и удобство работы с ними. Использование возможностей VBA будет полезным для любого пользователя программ от Microsoft. Без использования Visual Basic невозможна настоящая профессиональная работа с пакетом Microsoft Office.