Работа с макросами из макросов

Заголовок сообщения звучит несколько странно, но, как мне кажется, правильно.
Возникла у меня задача: создать динамическое меню, которое содержало бы в себе все доступные для выполнения макросы. Т.е. чтобы не открывать окно с макросами по Alt+F8, а иметь для этого дела меню, которое к тому же обновлялось автоматически, в зависимости от количества доступных макросов.
Кроме того, что нужно следить за формированием самого меню, которое рассматривается здесь, нужно решить такие задачи:

1. Определить загруженные шаблоны, макросы из которых доступны для выполнения.


2. Определить имена модулей, в которых содержится программный код макросов.


3. В каждом модуле найти собственно сами макросы.


4. Скомпоновать все это в меню.


5. Сделать, чтобы все это работало

Для работы с загруженными шаблонами используем свойство приложения Application.Templates. Чтобы определить, есть ли в шаблоне макросы пользуемся свойством VBProject, которое предоставляет некоторые инструменты для работы с содержимым шаблона.
Мной были разработаны некоторые функции:

• fGetModulesNames — функция, которая определяет имена модулей в конкретном шаблоне;


• fGetFuncNames — функция, которая определяет имена функций (макросов) в конкретном модуле конкретного шаблона;


• fGetFuncQuant — функция, которая определяет количество функций (макросов) в конкретном модуле конкретного шаблона;

    1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
   16 
   17 
   18 
   19 
   20 
   21 
   22 
   23 
   24 
   25 
   26 
   27 
   28 
   29 
   30 
   31 
   32 
   33 
   34 
   35 
   36 
   37 
   38 
   39 
   40 
   41 
   42 
   43 
   44 
   45 
   46 
   47 
   48 
   49 
   50 
   51 
   52 
   53 
   54 
   55 
   56 
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 
   67 
   68 
   69 
   70 
   71 
   72 
   73 
   74 
   75 
   76 
   77 
   78 
   79 
   80 
   81 
   82 
   83 
   84 
   85 
   86 
   87 
   88 
   89 
   90 
   91 
   92 
   93 
Public Function fGetFuncQuant(ByVal oCodeModuleName As VBComponent) As Long
'
'Функция определяет количество функций в указанном модуле.
'
  Dim nCounterOfProc, nEmptyCounter, i As Integer
  Dim sOld, sNew As String
'Если в указанном модуле есть более 1 строки
  If oCodeModuleName.codemodule.CountOfLines <> 0 Then
'Определяем номер строки, с которой считать строки кода
    Do
      nEmptyCounter = nEmptyCounter + 1
      sOld = oCodeModuleName.codemodule.ProcOfLine(nEmptyCounter, vbext_pk_Proc)
    Loop Until sOld <> ""
'Считаем процедуры в модуле, начиная со строки, номер которой определили выше
    For i = nEmptyCounter To oCodeModuleName.codemodule.CountOfLines
      If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
        sNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
        If sNew <> sOld Then
          sOld = sNew
          nCounterOfProc = nCounterOfProc + 1
        End If
      End If
    Next i
  End If
  fGetFuncQuant = nCounterOfProc
End Function

Public Function fGetFuncNames(ByVal oDocOrTemplName As Object, ByVal oCodeModuleName As VBComponent) As Variant
'
'Функция получает имена всех функций в модуле и записывает их в массив.
'
  Dim sProcNameNew, sProcNameOld As String
  Dim i, j, k As Integer
  Dim asFuncNames() As String 'массив для хранения имен функций в модуле
  ReDim asFuncNames(fGetFuncQuant(oCodeModuleName)) 'задаем размер массива
'Выбираем модуль документа или стандартный модуль с макросами.
'Также проверяем, чтобы в модуле были непустые строки
  If oCodeModuleName.Type = vbext_ct_StdModule _
      Or vbext_ct_Document _
      And oCodeModuleName.codemodule.CountOfLines <> 0 Then
    Do
      k = k + 1
      asFuncNames(0) = oCodeModuleName.codemodule.ProcOfLine(k, vbext_pk_Proc)
    Loop Until asFuncNames(0) <> ""
    For i = k To oCodeModuleName.codemodule.CountOfLines
      If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
        sProcNameNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
        If sProcNameNew <> asFuncNames(j) Then
          asFuncNames(j + 1) = sProcNameNew
          j = j + 1
        End If
      End If
    Next i
    k = 0
  End If
  fGetFuncNames = asFuncNames
End Function

Public Function fGetModulesNames(ByVal oDocOrTemplName As Object) As Variant
'
'Процедура определяем имена модулей с макросами в документе или шаблоне и записываем их в массив.
'
  Dim oCodeModuleName As VBComponent
  Dim nCounterOfModules As Integer 'счетчик программных модулей
  Dim asModulesNames() As String 'массив для хранения имен модулей с макросами. После выполнения
'этот массив возвращается как результат функции.
'Определяем количество нужных нам модулей, чтобы затем правильно задать размер массива. Свойство
'«Count» компонента «VBProject» не используем, т.к. нужно определить только количество модулей
'определенного типа.
  For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
    If oCodeModuleName.Type <> vbext_ct_ClassModule _
      And vbext_ct_ActiveXDesigner _
      And vbext_ct_MSForm _
      And InStr(oCodeModuleName.Name, "NNN") = 0 _
      And oCodeModuleName.codemodule.CountOfLines <> 0 Then
      nCounterOfModules = nCounterOfModules + 1
    End If
  Next oCodeModuleName
  ReDim asModulesNames(nCounterOfModules - 1)
  nCounterOfModules = 0
'Записываем в массив имена модулей
  For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
    If oCodeModuleName.Type <> vbext_ct_ClassModule _
      And vbext_ct_ActiveXDesigner _
      And vbext_ct_MSForm _
      And InStr(oCodeModuleName.Name, "NNN") = 0 _
      And oCodeModuleName.codemodule.CountOfLines <> 0 Then
      asModulesNames(nCounterOfModules) = oCodeModuleName.Name
      nCounterOfModules = nCounterOfModules + 1
    End If
  Next oCodeModuleName
  fGetModulesNames = asModulesNames
End Function