Все типы модулей VBA MS Excel позволяют создавать код, автоматически выполняемый при загрузке и/или выгрузке модуля.
Однако, для обычных модулей с макросами, VBComponent.Type=001, описание автоматической инициализации автор в сети не обнаружил.
В статье описан простой контроллер инициализации обычных модулей VBA.
Вступление
Автоматическая инициализация модуля 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.
Постановка задачи
Создать автоматический вызов процедур инициализации и завершения для обычных модулей VBA.
Повторить привычный механизм управления инициализацией — наличие в модуле VBA подпрограммы с известным именем.
Осуществлять автоматически инициализацию и завершение только тех модулей VBA, где присутствуют соответствующие подпрограммы.
Решение задачи
Синтаксис MS EXCEL VBA, допускает:
размещение в разных модулях подпрограмм с одинаковыми именами и интерфейсом;
косвенный вызов подпрограмм VBA по имени внутри переменной;
уточняющий синтаксис 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" <nik_garbuz@list.ru>
'
' 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 <nik_garbuz@list.ru>
' 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