VBA макросы. От бессмыслицы к осмысленному. Интерфейс

В первой части, через боль и страдания, мы написали ядро – основную логику макроса.
Сегодня поработаем над пользовательским интерфейсом.

У нас будет одна единственная форма, SettingsForm, со всеми нужными настройками и кнопкой для запуска. Саму форму и все, что будет с ней связано, поместим в папку UI.

Накидываем контролы

Я, обычно, выставляю фон на Button Face, шрифт Segoe UI 9pt. Так как мне нужно, чтобы шрифт применился для всей формы, я выставляю его до добавления контролов.

После, добавляю Frame, чтобы визуально выделить содержимое формы.
Получаем вот такой результат:

телевизор

Я еще люблю добавлять иконку на формы. Так можно обозначить для чего нужна конкретно эта форма (настройки, редактирование чего-либо и т.д.), или выделить главное окно макроса, сделать его немного отличным от других.
Есть парочка сайтов с бесплатными иконками, которыми можно воспользоваться.
Для нашего проекта я решил выбрать такую (формат png):

источник: https://www.flaticon.com/free-icon/filtering_10061709?term=filtering&page=1&position=34&origin=search&related_id=10061709

А теперь небольшой лайфхак

UserForm не поддерживает многие форматы изображений, в том числе png, а именно такого формата у нас иконка. Так же, если вставить картинку через интерфейс редактора, то скорее всего сильно потеряется качество. Я нашел такой способ, как убить двух зайцев разом:

1. Вставляем картинку на лист Excel. В разных версиях путь может отличаться, у меня так:

   

   вставка картинки

2. Меняем размер картинки. Его нужно подогнать под размер контейнера картинки (Image) в форме. В моем случае это: 1.57х1.57 см

3. Выделям и копируем через Ctrl+C

4. Далее, вставляем на форме элемент Image, убираем границы и фон (fmBorderStyleNone, fmBackStyleTransparent). Выставляем размер, у меня это 42х42.

5. В свойствах мышкой делаем активным пункт Picture и вставляем через Ctrl+V картинку из буфера:

   

   у меня уже вставлена, поэтому значение (Bitmap)

   Если с размером ошиблись, прогоняем заново, пока результат не устроит.

   Результат:

   

В итоге, после не хитрых манипуляций, у меня получилось такое окно (картинка на кнопку ставится по описанному выше принципу):

иконка папки: https://www.flaticon.com/free-icon/open-folder_3748664?term=folder&page=1&position=22&origin=search&related_id=3748664

тре манификь

По времени заняло минут 5-10. Чем больше таких окон делать, тем быстрее набьется рука.

Внизу разместил кнопку. Стандартный цвет кнопок не люблю менять, поэтому чтобы визуально она не терялась, оттенил фон. Стиль элементов flat. Выглядит менее угловато, чем стандартный. Но это все вкусовщина.

За границу формы я вынес кнопку со свойством Cancel = True. Дело в том, что я настолько привык закрывать различные окна внутри программ с помощью клавиши Esc, что мне кажется это максимально логичным действием. Так вот это свойство как раз реагирует на нажатие Esc и вызывает Click event кнопки, на которой оно установлено. На это событие мы вешаем Unload Me, чтобы закрыть форму и кайфуем. Теперь можно закрывать форму по нажатию на Esc.

Кнопка за границей формы

Private Sub CloseCommandButton_Click()
    Unload Me ' Вешаем на событие выгрузку форму
End Sub

Config

Когда мы делаем форму, мы подразумеваем, что некоторые или даже все элементы на ней будут сохранять свое состояние даже после выхода из Excel. Например очень удобно бывает один раз указать путь к файлу и больше не менять это значение (если файл просто перезаписывается).

Моя первая статья на habr как раз была про то, как можно хранить конфигурацию.

С момента написания этой статьи прошло достаточно времени, и я немного отошел от этого варианта и храню конфигурацию в реестре с помощью стандартных средств VBA. Это позволяет не писать логику чтения и записать данных (они уже написаны), а так же дает возможно��ть передавать новые версии файла с макросом от сотрудника к сотруднику не сбивая личные пользовательские настройки.

Как уже стало понятно из первой части – я люблю обертки.

Поэтому, для работы с конфигом мы напишем небольшую обертку.

Создадим класс Config и модуль конструктор (подробнее про конструктор тут), и добавим в него пару методов:

' Модуль ConfigCstr
Public Function NewConfig(ByVal AppName As String) As Config
    Set NewConfig = New Config
    NewConfig.SetAppName AppName
End Function


' Класс Config
Private Type TConfig
    AppName As String
    Section As String
End Type

Private this As TConfig

Public Function SetAppName(ByVal Name As String) As Config
    this.AppName = Name
    Set SetAppName = Me
End Function

Public Function SetSection(ByVal Name As String) As Config
    this.Section = Name
    Set SetSection = Me
End Function

Public Sub SetValue(ByVal Key As String, ByVal Value As String)
    CheckSettings

    SaveSetting this.AppName, this.Section, Key, Value
End Sub

Public Function GetValue( _
    ByVal Key As String, _
    Optional ByVal DefaultValue As Variant = Empty, _
    Optional ByVal CastType As VbVarType = VbVarType.vbString _
) As Variant
    CheckSettings

    GetValue = Cast(GetSetting(this.AppName, this.Section, Key, DefaultValue), CastType)
End Function

Private Sub CheckSettings()
    If Len(this.AppName) = 0 Then Err.Raise 91, TypeName(Me), "Не задана переменная AppName."
    If Len(this.Section) = 0 Then Err.Raise 91, TypeName(Me), "Не задана переменная Section."
End Sub

Private Function Cast(ByVal Value As Variant, ByVal CastType As VbVarType) As Variant
    Select Case CastType
    Case vbString: Cast = CStr(Value)
    Case vbBoolean
        On Error Resume Next
        Cast = CBool(Value)
        Cast = iif(Err.Number = 0, Cast, false)
    End Select
End Function

Стандартные методы Set и Get Value, для установки/получения значения. Здесь я добавил возврат текущего инстанса класса, для того, чтобы можно было менять эти значения и записывать настройки в одну строку, типа:

Config.SetAppName("SomeApp").SetSection("Section").SetValue "SomeKey", "SomeValue"

Так же, есть два вспомогательных метода CheckSettings и Cast.
Первый для проверки, что мы установили имя приложения и секцию настроек, куда мы вносим конкретные ключ/значение. Можно, конечно, их вписать жестко, но лучше стараться писать переиспользуемые модули, если это возможно, чтобы они не зависели от конкретного проекта. Конфиг как нельзя лучше подходит на эту роль.

Cast – вспомогательная функция для приведения к какому либо типу нашего значения. Возьмем стандартный enum VbVarType для выбора к какому типу приводить. Я реализовал только два типа, так как именно они нужны будут дальше. Преобразование boolean немного необычное, так как, к примеру, null или "" нельзя перевести в boolean, поэтому если была ошибка, мы будем возвращать False.

Ну и функция конструктор, куда ж без нее.

FormController

Раньше я писал всю логику и обработку формы в модуле самой формы, но в итоге все это приводило к ужасной мешанине несвязного между собой кода. Поэтому SettingsFormController (с конструктором, есессно):

' Модуль SettingsFormControllerCstr
Public Function NewSettingsFormController(ByRef Form As MSForms.UserForm, ByRef Config As Config) As SettingsFormController
    Set NewSettingsFormController = New SettingsFormController
    Set NewSettingsFormController.Form = Form
    Set NewSettingsFormController.Config = Config
End Function


' Класс SettingsFormController
Private Type TSettingsFormController
    Config As Config
    Form As MSForms.UserForm
End Type

Private this As TSettingsFormController

Public Property Set Config(ByVal RHS As Config)
    Set this.Config = RHS
End Property

Public Property Set Form(ByVal RHS As MSForms.UserForm)
    Set this.Form = RHS
End Property

Public Sub LoadValues()
    Dim Control As MSForms.Control
    For Each Control In this.Form.Controls
        If Strings.Len(Control.Tag) = 0 Then GoTo Continue

        Dim CastType As VbVarType
        If IsTextBox(Control) Then
            CastType = vbString
        ElseIf IsOptionButton(Control) Then
            CastType = vbBoolean
        Else
            GoTo Continue
        End If

        Dim Value As Variant
        Value = this.Config.GetValue(Control.Tag, CastType:=CastType)
        If IsEmpty(Value) Then GoTo Continue
        Control.Value = Value
Continue:
    Next
End Sub

Public Sub SaveValues()
    Dim Control As MSForms.Control
    For Each Control In this.Form.Controls
        If Not IsTextBox(Control) _
        And Not IsOptionButton(Control) Then GoTo Continue

        Me.SaveValue Control
Continue:
    Next
End Sub

Public Sub SaveValue(ByRef Control As Control)
    this.Config.SetValue Control.Tag, Control.Value
End Sub

Логика простая, с помощью этого класса мы даем интерфейс для сохранения значения/значений элементов управления и для загрузки из конфига.

В нашем конкретном случае нам нужны только TextBox и OptionButton, поэтому в Utils добавляем две вспомогательные функции, чтобы отсекать все остальные элементы управления:

Public Function IsTextBox(ByVal Control As MSForms.Control) As Boolean
    IsTextBox = TypeName(Control) = "TextBox"
End Function

Public Function IsOptionButton(ByVal Control As MSForms.Control) As Boolean
    IsOptionButton = TypeName(Control) = "OptionButton"
End Function

Важный элемент – тэги. Их мы будем использовать для удобного обращения к конфигу:

' Модуль FormTags
Public Const FilePath As String = "FilePath"
Public Const GT20Collector As String = "GT20Collector"
Public Const LT20Collector As String = "LT20Collector"

В модуле формы, создаем обработчики:

Private Type TSettingsForm
    Controller As SettingsFormController
End Type

Private this As TSettingsForm

Private Sub UserForm_Initialize()
    SetTags

    Set this.Controller = NewSettingsFormController( _
        Form:=Me, _
        Config:=NewConfig(Constants.APP_NAME_ENG).SetSection("Settings") _
    )

    this.Controller.LoadValues
End Sub

Private Sub SetTags()
    Me.FilePathTextBox.Tag = FormTags.FilePath
    Me.GT20OptionButton.Tag = FormTags.GT20Collector
    Me.LT20OptionButton.Tag = FormTags.LT20Collector
End Sub

Private Sub SelectFilePathCommandButton_Click()
    Dim Path As Variant
    Path = Application.GetOpenFilename( _
        Title:="Укажите путь к файлу отчета", _
        FileFilter:="Excel Файлы (*.xls*), *.xls*" _
    )

    If IsBoolType(Path) Then Exit Sub
    Me.FilePathTextBox.Value = Path
End Sub

Private Sub RunCommandButton_Click()
    this.Controller.SaveValues
    App.Main
    Unload Me
End Sub

Private Sub CloseCommandButton_Click()
    Unload Me
End Sub


' Модуль Utils
Public Function IsBoolType(ByVal Value As Variant) As Boolean
    IsBoolType = VarType(Value) = vbBoolean
End Function

1. При инициализации привязываем тэги, создаем новый контроллер и передаем в него саму форму плюс конфиг с уже выставленной секцией Settings (помните же, что метод SetSection возвращает инстанс текущего Config объекта?). Вызываем метод загрузки значений.

2. При нажатии на кнопку выбора файла, вызываем стандартный диалог GetOpenFileName и проверяем полученный тип результата, если boolean – выходим из процедуры, т.к. пользователь нажал кнопку Отмена. В противном случае записываем в TextBox полученной значение.

3. При нажатии на кнопку Выполнить, сохраняем все текущие значения, вызываем Main процедуру и выгружаем форму.

Собственно, почти все, осталось еще добавить проверку перед запуском на то, что у нас все корректно заполнено и выбран хотя бы один сборщик:

' Класс SettingsFormController
Public Function IsPrepairedToRun(ParamArray Controls() As Variant) As TCheckResult
    Dim OptionSelected As Boolean

    Dim Control As Variant
    For Each Control In Controls
        If IsTextBox(Control) Then
            If Strings.Len(Control.Value) = 0 Then
                IsPrepairedToRun.HasError = True
                IsPrepairedToRun.Message = "Не указан путь к файлу."
                Exit Function
            ElseIf Not NewFileSystemObject().FileExists(Control.Value) Then
                IsPrepairedToRun.HasError = True
                IsPrepairedToRun.Message = "Указанный файл не найден."
                Exit Function
            End If
        ElseIf IsOptionButton(Control) Then
            If Not OptionSelected Then OptionSelected = Control.Value
        Else
            GoTo Continue
        End If
Continue:
    Next

    If Not OptionSelected Then
        IsPrepairedToRun.HasError = True
        IsPrepairedToRun.Message = "Не выбран ни один тип сборки."
    End If
End Function

1. Получаем элементы управления для проверки и в цикле проходим по каждому.

2. В случае с TextBox проверяем что значение не пусто и то что указанный файл существует, в противно случае добавляем сообщение об ошибке.

3. В случае с OptionButton записываем в переменную OptionSelected значения опций до тех пор, пока она не станет True и в конце функции проверяем, выбран ли хотя бы один тип сборки.

В форме корректируем обработчик нажатия на кнопку Выполнить:

Private Sub RunCommandButton_Click()
    this.Controller.SaveValues

    Dim Check As TCheckResult
    Check = this.Controller.IsPrepairedToRun( _
        Me.FilePathTextBox, _
        Me.GT20OptionButton, _
        Me.LT20OptionButton _
    )

    If Check.HasError Then
        MsgBox Check.Message, vbExclamation, "Ошибка запуска"
        Exit Sub
    End If

    App.Main
    Unload Me
End Sub

Проверяем:

работает, получается

Осталось научить макрос читать настройки.

Добиваем логику

Напомню, нам нужно заполнить переменные FilePath и Kind.

Сначала инициализируем Config в Main процедуре. С FilePath все просто, нам нужно лишь достать конкретно значение пути из конфига, а вот для типа сборщика мы напишем доп функцию в модуле CollectorTypes:

Public Enum CollectorKind
    GT20
    LT20
End Enum

Public Function GetCollectorKind(ByRef Config As Config) As CollectorKind
    If Config.GetValue(FormTags.GT20Collector, CastType:=vbBoolean) Then
        GetCollectorKind = GT20
    ElseIf Config.GetValue(FormTags.LT20Collector, CastType:=vbBoolean) Then
        GetCollector = LT20
    Else
        Err.Raise 9, "GetCollectorKind", "Выбран неизвестный тип сборщика."
    End If
End Function

Почему здесь? Потому что в случае если нужно будет добавить новый тип в enum, мы тут же добавим логику в функцию. Удобно же.

Пара штрихов

Это еще не все. Во-первых, нам нужно поставить напоминалку о DEV режиме. Сделать это можно несколькими способами, но я люблю добавлять MsgBox с соответствующими сообщениями в Main (чтобы очередной раз себе напомнить) и в событие перед закрытием книги (чтобы случайно не отдать клиенту dev-версию):

' ЭтаКнига
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    #If DEV Then
        Dim Confirm As VbMsgBoxResult
        Confirm = MsgBox( _
            "Книга находится в режиме разработки. Продолжить?", _
            vbQuestion + vbYesNo, _
            "DEV MODE" _
        )
        Cancel = Confirm = vbNo
    #End If
End Sub

' Модуль App
Public Sub Main()
    On Error GoTo Catch

    #If DEV Then
        MsgBox "Макрос запущен в режиме разработки.", vbInformation, "DEV MODE"
    #End If

    Utils.DisableSettings
  ' ....
End Sub

Во-вторых, нам нужен еще один модуль, для обработки нажатия на кнопку. Мы не будем использовать ActiveX, а возьмем кнопку из элементов управления формы, а она должна сослаться на существующую процедуру:

' Модуль ButtonHandlers
'@Folder("GoodsCollectorProject.src.UI")
Option Explicit

Public Sub ShowSettings_Click()
    SettingsForm.Show
End Sub

Вот теперь можно добавить кнопку, скрыть все лишнее и выдыхать, мы закончили:

Итоги

На этом наш рефакторинг закончен. Мы написали довольно много кода, но бОльшую его часть с легкостью можем переиспользовать в других проектах, сохранив лаконичность. Так же, мы оставили задел на будущее, для удобного масштабирования логики.

Итоговый вид проекта:

Бонус, итоговый вид проекта без Rubberduck

Спасибо, что прочитали до конца! 😃 Надеюсь было интересно и познавательно.

Код из статьи: GitHub

Мой телеграм: Дневник VBAшника