Все типы модулей 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
ссылка на оригинал статьи https://habr.com/ru/post/682468/
Добавить комментарий