Источник: wordmacroses
Александр Витер
Возникла у меня задача: создать динамическое меню, которое содержало бы в себе все доступные для выполнения макросы. Т.е. чтобы не открывать окно с макросами по Alt+F8, а иметь для этого дела меню, которое к тому же обновлялось автоматически, в зависимости от количества доступных макросов.
Нужно решить такие задачи:
- Определить загруженные шаблоны, макросы из которых доступны для выполнения.
- Определить имена модулей, в которых содержится программный код макросов.
- В каждом модуле найти собственно сами макросы.
- Скомпоновать все это в меню.
- Сделать, чтобы все это работало
Для работы с загруженными шаблонами используем свойство приложения Application.Templates. Чтобы определить, есть ли в шаблоне макросы пользуемся свойством VBProject, которое предоставляет некоторые инструменты для работы с содержимым шаблона.
Мной были разработаны некоторые функции:
- fGetModulesNames - функция, которая определяет имена модулей в конкретном шаблоне;
- fGetFuncNames - функция, которая определяет имена функций (макросов) в конкретном модуле конкретного шаблона;
- fGetFuncQuant - функция, которая определяет количество функций (макросов) в конкретном модуле конкретного шаблона;
Функции для работы с компонентами Visual Basic for Application Скопировать код в буфер обмена
1 Public Function fGetFuncQuant(ByVal oCodeModuleName As VBComponent) As Long
2 '
3 'Функция определяет количество функций в указанном модуле.
4 '
5 Dim nCounterOfProc, nEmptyCounter, i As Integer
6 Dim sOld, sNew As String
7 'Если в указанном модуле есть более 1 строки
8 If oCodeModuleName.codemodule.CountOfLines <> 0 Then
9 'Определяем номер строки, с которой считать строки кода
10 Do
11 nEmptyCounter = nEmptyCounter + 1
12 sOld = oCodeModuleName.codemodule.ProcOfLine(nEmptyCounter, vbext_pk_Proc)
13 Loop Until sOld <> ""
14 'Считаем процедуры в модуле, начиная со строки, номер которой определили выше
15 For i = nEmptyCounter To oCodeModuleName.codemodule.CountOfLines
16 If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
17 sNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
18 If sNew <> sOld Then
19 sOld = sNew
20 nCounterOfProc = nCounterOfProc + 1
21 End If
22 End If
23 Next i
24 End If
25 fGetFuncQuant = nCounterOfProc
26 End Function
27
28 Public Function fGetFuncNames(ByVal oDocOrTemplName As Object, ByVal oCodeModuleName As VBComponent) As Variant
29 '
30 'Функция получает имена всех функций в модуле и записывает их в массив.
31 '
32 Dim sProcNameNew, sProcNameOld As String
33 Dim i, j, k As Integer
34 Dim asFuncNames() As String 'массив для хранения имен функций в модуле
35 ReDim asFuncNames(fGetFuncQuant(oCodeModuleName)) 'задаем размер массива
36 'Выбираем модуль документа или стандартный модуль с макросами.
37 'Также проверяем, чтобы в модуле были непустые строки
38 If oCodeModuleName.Type = vbext_ct_StdModule _
39 Or vbext_ct_Document _
40 And oCodeModuleName.codemodule.CountOfLines <> 0 Then
41 Do
42 k = k + 1
43 asFuncNames(0) = oCodeModuleName.codemodule.ProcOfLine(k, vbext_pk_Proc)
44 Loop Until asFuncNames(0) <> ""
45 For i = k To oCodeModuleName.codemodule.CountOfLines
46 If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
47 sProcNameNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
48 If sProcNameNew <> asFuncNames(j) Then
49 asFuncNames(j + 1) = sProcNameNew
50 j = j + 1
51 End If
52 End If
53 Next i
54 k = 0
55 End If
56 fGetFuncNames = asFuncNames
57 End Function
58
59 Public Function fGetModulesNames(ByVal oDocOrTemplName As Object) As Variant
60 '
61 'Процедура определяем имена модулей с макросами в документе или шаблоне и записываем их в массив.
62 '
63 Dim oCodeModuleName As VBComponent
64 Dim nCounterOfModules As Integer 'счетчик программных модулей
65 Dim asModulesNames() As String 'массив для хранения имен модулей с макросами. После выполнения
66 'этот массив возвращается как результат функции.
67 'Определяем количество нужных нам модулей, чтобы затем правильно задать размер массива. Свойство
68 '"Count" компонента "VBProject" не используем, т.к. нужно определить только количество модулей
69 'определенного типа.
70 For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
71 If oCodeModuleName.Type <> vbext_ct_ClassModule _
72 And vbext_ct_ActiveXDesigner _
73 And vbext_ct_MSForm _
74 And InStr(oCodeModuleName.Name, "NNN") = 0 _
75 And oCodeModuleName.codemodule.CountOfLines <> 0 Then
76 nCounterOfModules = nCounterOfModules + 1
77 End If
78 Next oCodeModuleName
79 ReDim asModulesNames(nCounterOfModules - 1)
80 nCounterOfModules = 0
81 'Записываем в массив имена модулей
82 For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
83 If oCodeModuleName.Type <> vbext_ct_ClassModule _
84 And vbext_ct_ActiveXDesigner _
85 And vbext_ct_MSForm _
86 And InStr(oCodeModuleName.Name, "NNN") = 0 _
87 And oCodeModuleName.codemodule.CountOfLines <> 0 Then
88 asModulesNames(nCounterOfModules) = oCodeModuleName.Name
89 nCounterOfModules = nCounterOfModules + 1
90 End If
91 Next oCodeModuleName
92 fGetModulesNames = asModulesNames
93 End Function
1 Public Function fGetFuncQuant(ByVal oCodeModuleName As VBComponent) As Long
2 '
3 'Функция определяет количество функций в указанном модуле.
4 '
5 Dim nCounterOfProc, nEmptyCounter, i As Integer
6 Dim sOld, sNew As String
7 'Если в указанном модуле есть более 1 строки
8 If oCodeModuleName.codemodule.CountOfLines <> 0 Then
9 'Определяем номер строки, с которой считать строки кода
10 Do
11 nEmptyCounter = nEmptyCounter + 1
12 sOld = oCodeModuleName.codemodule.ProcOfLine(nEmptyCounter, vbext_pk_Proc)
13 Loop Until sOld <> ""
14 'Считаем процедуры в модуле, начиная со строки, номер которой определили выше
15 For i = nEmptyCounter To oCodeModuleName.codemodule.CountOfLines
16 If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
17 sNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
18 If sNew <> sOld Then
19 sOld = sNew
20 nCounterOfProc = nCounterOfProc + 1
21 End If
22 End If
23 Next i
24 End If
25 fGetFuncQuant = nCounterOfProc
26 End Function
27
28 Public Function fGetFuncNames(ByVal oDocOrTemplName As Object, ByVal oCodeModuleName As VBComponent) As Variant
29 '
30 'Функция получает имена всех функций в модуле и записывает их в массив.
31 '
32 Dim sProcNameNew, sProcNameOld As String
33 Dim i, j, k As Integer
34 Dim asFuncNames() As String 'массив для хранения имен функций в модуле
35 ReDim asFuncNames(fGetFuncQuant(oCodeModuleName)) 'задаем размер массива
36 'Выбираем модуль документа или стандартный модуль с макросами.
37 'Также проверяем, чтобы в модуле были непустые строки
38 If oCodeModuleName.Type = vbext_ct_StdModule _
39 Or vbext_ct_Document _
40 And oCodeModuleName.codemodule.CountOfLines <> 0 Then
41 Do
42 k = k + 1
43 asFuncNames(0) = oCodeModuleName.codemodule.ProcOfLine(k, vbext_pk_Proc)
44 Loop Until asFuncNames(0) <> ""
45 For i = k To oCodeModuleName.codemodule.CountOfLines
46 If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
47 sProcNameNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
48 If sProcNameNew <> asFuncNames(j) Then
49 asFuncNames(j + 1) = sProcNameNew
50 j = j + 1
51 End If
52 End If
53 Next i
54 k = 0
55 End If
56 fGetFuncNames = asFuncNames
57 End Function
58
59 Public Function fGetModulesNames(ByVal oDocOrTemplName As Object) As Variant
60 '
61 'Процедура определяем имена модулей с макросами в документе или шаблоне и записываем их в массив.
62 '
63 Dim oCodeModuleName As VBComponent
64 Dim nCounterOfModules As Integer 'счетчик программных модулей
65 Dim asModulesNames() As String 'массив для хранения имен модулей с макросами. После выполнения
66 'этот массив возвращается как результат функции.
67 'Определяем количество нужных нам модулей, чтобы затем правильно задать размер массива. Свойство
68 '"Count" компонента "VBProject" не используем, т.к. нужно определить только количество модулей
69 'определенного типа.
70 For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
71 If oCodeModuleName.Type <> vbext_ct_ClassModule _
72 And vbext_ct_ActiveXDesigner _
73 And vbext_ct_MSForm _
74 And InStr(oCodeModuleName.Name, "NNN") = 0 _
75 And oCodeModuleName.codemodule.CountOfLines <> 0 Then
76 nCounterOfModules = nCounterOfModules + 1
77 End If
78 Next oCodeModuleName
79 ReDim asModulesNames(nCounterOfModules - 1)
80 nCounterOfModules = 0
81 'Записываем в массив имена модулей
82 For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
83 If oCodeModuleName.Type <> vbext_ct_ClassModule _
84 And vbext_ct_ActiveXDesigner _
85 And vbext_ct_MSForm _
86 And InStr(oCodeModuleName.Name, "NNN") = 0 _
87 And oCodeModuleName.codemodule.CountOfLines <> 0 Then
88 asModulesNames(nCounterOfModules) = oCodeModuleName.Name
89 nCounterOfModules = nCounterOfModules + 1
90 End If
91 Next oCodeModuleName
92 fGetModulesNames = asModulesNames
93 End Function