MS Excel — Инициализация модулей VBA

В статье описан простой контроллер инициализации модулей VBA Excel.

Все типы модулей VBA MS Excel позволяют создавать код, автоматически выполняемый при загрузке и/или выгрузке модуля.

Однако, для обычных модулей с макросами, VBComponent.Type=001, примера автоматической инициализации автор в сети не обнаружил.

Вступление

Автоматическая инициализация модуля VBA MS Excel производится по факту наличия в модуле подпрограммы с заданным интерфейсом.

Это удобно. Наличие подпрограммы с заданным интерфейсом включает автоматические инициализацию модуля. Удаление из кода модуля подпрограммы — выключает.

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

Private Sub Worksheet_Activate()
    ' your code here
End Sub

Private Sub Worksheet_Deactivate()
    ' your code here
End Sub

Первая подпрограмма автоматически вызывается перед получением фокуса ввода. Например, для установки начальных значений переменных.

Вторая — перед тем как, как фокус ввода будет потерян.

В других листах электронных таблиц эти функции могут отсутствовать, если в инициализации там потребности нет.

Таким же образом устроен механизм инициализации классов, книг и форм MS Excel.

Но, иногда возникает потребность автоматической инициализации обычных модулей с макросами, Type=001.

Постановка задачи

1. Создать автоматический вызов процедур инициализации и завершения для обычных модулей VBA.

2. Повторить привычный механизм управления инициализацией — наличие в модуле VBA подпрограммы с известным именем.

3. Осуществлять автоматически инициализацию и завершение только тех модулей VBA, где присутствуют соответствующие подпрограммы.

Решение задачи

Синтаксис MS EXCEL VBA, допускает:

1. размещение в разных модулях подпрограмм с одинаковыми именами и интерфейсом;

2. косвенный вызов подпрограмм VBA по имени внутри переменной;

3. уточняющий синтаксис VBA.

Договоримся об именовании подпрограмм инициализации и завершения:

• moduleInit(ByRef Wb As Workbook) — автоматически вызываемая процедура инициализации;

• moduleLeave(ByRef Wb As Workbook) — автоматически вызываемая процедура завершения;

• В любом модуле VBA, подпрограммы инициализации могут отсутствовать или присутствовать, совместно или по одной.

Подпрограммы инициализации принимают один параметр, Wb, хранящий ссылку на книгу, для которой производится инициализация мод��ля макросов.

Инициализируемый модуль определяется местоположением вызываемой подпрограммы.

Для включения автоматической инициализации добавляем в любое место модуля макросов подпрограмму инициализации:

Option Explicit

' Your VBA module code here

Public Sub moduleInit(ByRef Wb As Workbook)

' The starting code for your VBA module is here

End Sub

Для завершения работы модуля, помещаем соответствующую подпрограмму где-нибудь рядом:

Option Explicit

' Your VBA module code here

Public Sub moduleLeave(ByRef Wb As Workbook)

' The final code for your VBA module is here

End Sub

Public Sub moduleInit(ByRef Wb As Workbook)

' The starting code for your VBA module is here

End Sub

Удаляем текст договорных подпрограмм, если потребности в инициализации модуля нет.

Контроллер инициализации

Интерфейс контроллера инициализации содержит две константы и одну подпрограмму.

Public Const vbaMODULE_INIT As String = "moduleInit"
Public Const vbaMODULE_LEAVE As String = "moduleLeave"

Public Sub vbaWbModuleControl( _
			subName As String, _
			Optional printDebugOnly As Boolean = False)

Константы закрепляют договор вызова подпрограмм инициализации и завершения обычных модулей VBA MS Excel.

Прототипы подпрограмм инициализации завершения:

Public Sub moduleInit(ByRef Wb As Workbook)	' module initialization
Public Sub moduleLeave(ByRef Wb As Workbook)	' module completion

В подпрограмме контроллера инициализации vbaWbModuleControl два параметра:

• subName — название подпрограммы инициализации или завершения;

• printDebugOnly — запуск контроллера в режиме отладки.

Каждый раз при вызове, контроллер инициализации «пробегает» по всем модулям проекта VBA MS Excel, создаёт список подпрограмм с именем subName по факту их присутствия, запускает на исполнение передавая, как параметр, объект рабочей книги.

Порядок запуска подпрограмм инициализации определяется порядком создания модулей VBA.

Запуск vbaWbModuleControl с параметром printDebugOnly=True выдаёт на консоль отладки список всех функций инициализации или завершения в порядке вызова, но без вызова.

Для инициализации модулей макросов по событиям получения или потери фокуса ввода электронной таблицы, контроллер инициализации размещается в обработчике событий _Activate().

Private Sub Workbook_Activate()

	vbaWbModuleControl vbaMODULE_INIT

End Sub

Private Sub Workbook_Deactivate()

	vbaWbModuleControl vbaMODULE_LEAVE

End Sub

Для одноразового вызова процедур инициализации и завершения достаточно переместить вызов контроллера в обработчики открытия и закрытия книги электронной таблицы.

Private Sub Workbook_Open()

 	vbaWbModuleControl vbaMODULE_INIT

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  vbaWbModuleControl vbaMODULE_LEAVE

End Sub

Для восстановления инициализации после сбоя во время отладки контроллер запускается в ручном режиме.

Sub ReInitProject()

 	vbaWbModuleControl vbaMODULE_INIT

End Sub

Интеграция контроллера

Контроллер инициализации интегрируется в новый проект простым переносом исходного текста [^C;^V] в модуль макросов VBA Excel.

Контроллер работает без начальной инициализации.

В современных версиях MS Excel дополнительно отмечается чекбокс «Доверять доступ к объектной модели макросов VBA» в разделе «Центр управления безопасности».

Исходный код контроллера инициализации

Attribute VB_Name = "mWbInit"
'***************************************************************************
' Module "mWbInit.bas"
' Controller for automatic initialization of VBA modules
'
' Copyright (c) 2022, "Nikolay E. Garbuz" <[e-mail]>
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License version 3 as
' published by the Free Software Foundation.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public License
' along with this program.  If not, see <http://www.gnu.org/licenses/>.
'
' Authored by Nikolay Garbuz <[e-mail]>
' Modified by
'
' TAB Size .EQ 4
'***************************************************************************

Option Explicit
Option Compare Text

' Public Sub moduleInit(ByRef Wb As Workbook)
Public Const vbaMODULE_INIT As String = "moduleInit"

' Public Sub moduleLeave(ByRef Wb As Workbook)
Public Const vbaMODULE_LEAVE As String = "moduleLeave"


' Call vbaWbModuleControl vbaMODULE_INIT    ' for initialization
' Call vbaWbModuleControl vbaMODULE_LEAVE   ' for release

Public _
Sub vbaWbModuleControl( _
                        subName As String, _
                        Optional printDebugOnly As Boolean = False _
)
    vbaWbModuleRun ThisWorkbook, subName, printDebugOnly
End Sub

Public _
Sub vbaWbModuleRun( _
                    ByRef Wb As Workbook, _
                    subName As String, _
                    Optional printDebugOnly As Boolean = False _
)
    Dim i As Integer
    Dim subList() As String
    
    i = vbaSubroutineList(ThisWorkbook, subName, subList)
    
    If i > 0 Then
        If printDebugOnly Then
            Debug.Print Join(subList(), vbCrLf)
        Else
            For i = LBound(subList) To UBound(subList)
                Application.Run subList(i), Wb
            Next i
        End If
    End If
    
    Erase subList
End Sub

Private _
Function vbaSubroutineList( _
                                ByRef Wb As Workbook, _
                                sName As String, _
                                ByRef sList() As String _
) As Integer

    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim sc As Long
    Dim fc As Long
    Dim sLine As String
    Dim modName As String
    Dim subName As String
    Dim chkName As String
    
    ReDim sList(0)
    
    i = InStr(sName, ".")
    
    If i > 0 Then
        modName = Left(sName, i - 1)
        subName = Mid(sName, i + 1)
    Else
        modName = ""
        subName = sName
    End If
    
    sc = vbaModuleIdx(Wb, modName)
    If sc > 0 Then
        fc = sc
    Else
        sc = 1
        fc = Wb.VBProject.VBComponents.Count
    End If
    
    With Wb.VBProject.VBComponents
        For i = sc To fc
            l = .Item(i).CodeModule.CountOfLines
            For j = 1 To l
                chkName = ""
                Do
                    sLine = .Item(i).CodeModule.Lines(j, 1)
                    If Right(sLine, 1) = "_" Then
                        chkName = chkName & Left(sLine, Len(sLine) - 1)
                        j = j + 1
                    Else
                        chkName = chkName & sLine
                        Exit Do
                    End If
                Loop

                chkName = vbaRemComment(chkName)
                chkName = vbaRemPrefix(chkName)
                chkName = vbaRemIdentLine(chkName)
                chkName = vbaSubroutineName(chkName)
                
                If chkName <> "" Then
                    If subName = "*" Or StrComp(subName, chkName) = 0 Then
                        If UBound(sList) < k Then
                            ReDim Preserve sList(UBound(sList) + 10)
                        End If
                        
                        sList(k) = .Item(i).Name & "." & chkName
                        k = k + 1
                    End If
                End If
            Next j
        Next i
    End With
    
    If k > 0 Then
        ReDim Preserve sList(k - 1)
    End If

    vbaSubroutineList = k

End Function

Private _
Function vbaModuleIdx( _
    							ByRef Wb As Workbook, _
    							sModuleName As String _
) As Integer

    Dim i As Integer
    Dim m As String
    
    vbaModuleIdx = 0
    
    With Wb.VBProject.VBComponents
        For i = 1 To .Count
            m = .Item(i).Name
            If StrComp(sModuleName, m) = 0 Then
                vbaModuleIdx = i
                Exit Function
            End If
        Next i
    End With
    
End Function

Private _
Function vbaSubroutineName(sLn As String) As String
    
    Const maskSubName As String = "sub *(*)*"
    Const maskFuncName As String = "function *(*)*"
    
    Dim p_space As Integer
    Dim p_bra As Integer
    Dim sn As String
    
    sn = ""
    
    If (sLn Like maskSubName) Or (sLn Like maskFuncName) Then
        p_space = InStr(sLn, " ") + 1
        p_bra = InStr(sLn, "(")
        sn = Mid(sLn, p_space, p_bra - p_space)
    End If
    
    vbaSubroutineName = Trim(sn)

End Function

Private _
Function vbaRemComment(sLn As String) As String
    
    Const comSymbols = "REM ,', REM ,: REM "
   
    Dim i As Long
    Dim s As String
    Dim pc As Long
    
    Static csym() As String

    On Error GoTo InitArray

    i = 0
    Do
        s = csym(i)
        
        pc = InStr(sLn, s)
        
        If pc = 1 Then
            sLn = ""
            Exit Do
        Else
            If pc > 1 And i > 0 Then
                sLn = Left(sLn, pc - 1)
                Exit Do
            End If
        End If
        
        i = i + 1
    Loop Until i > UBound(csym)
    
    vbaRemComment = sLn
    
    On Error GoTo 0
    
    Exit Function
    
InitArray:
    csym = Split(comSymbols, ",")
    s = csym(0)
    Resume Next
    
End Function

Private _
Function vbaRemPrefix(sLn As String) As String
    
      Const prefixKeys = "Public ,Private ,Friend ,Static "

    Dim i As Long
    Dim s As String
    Dim ps As Long
    Dim pf As Long
    
    Static pref() As String
    
    On Error GoTo InitArray
    
    i = 0
    Do
        s = pref(i)
        
        ps = InStr(sLn, s)
        
        If ps > 0 Then
            pf = ps + Len(s)
            If ps = 1 Then
                sLn = Mid(sLn, pf)
            Else
                sLn = Left(sLn, ps - 1) & Mid(sLn, pf)
            End If
        End If
        
        i = i + 1
    Loop Until i > UBound(pref)
    
    vbaRemPrefix = sLn
    
    On Error GoTo 0
    
    Exit Function
    
InitArray:
    pref = Split(prefixKeys, ",")
    s = pref(0)
    Resume Next
    
End Function

Private _
Function vbaRemIdentLine(sLn As String) As String
    
    Const lnSymbols = " " & vbTab & vbCr & vbLf

    While sLn <> "" And InStr(lnSymbols, Left(sLn, 1)) > 0
        sLn = Mid(sLn, 2)
    Wend
    
    vbaRemIdentLine = sLn
End Function