Вот так выглядит результат:
В XML-схеме шаблона меню задано так:
| 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 94 95 96 97 98 | Sub DynMenuGetMacroAuto_GetContent(control As IRibbonControl, ByRef content) ' 'Формирование динамического меню со всеми макросами, доступными для данного документа ' Dim sXML As String 'строка, в которую записывается содержимое динамического меню Dim i, j, IDcounter As Integer 'счетчики циклов и идентификаторов компонентов Dim asModulesNames, asFuncNames As Variant 'массивы для хранения имен функций и модулей 'Начало формирования динамического меню sXML = "<menu xmlns=""" & "http://schemas.microsoft.com/office/2006/01/customui" & """>" & vbCr '-------------------------- 'Кнопка «Обновить» '-------------------------- sXML = sXML & vbTab & _ "<button id=""RefreshDynMenu"" " & _ "label=""Обновить"" " & _ "screentip=""Обновить содержимое этого меню"" " & _ "supertip=""Нажмите для обновления содержимого меню. Это необходимо делать, " & _ "если вы изменяете проект Visual Basic для данного документа. Или присоединяете " & _ "новые шаблоны."" " & _ "onAction=""RefreshDynMenu_OnAction"" " & _ "imageMso=""RecurrenceEdit""/>" & vbCr & vbTab & _ "<menuSeparator id=""MenuSep1""/>" & vbCr '---------------------------------------------------------------------- 'Формирование пунктов меню для каждого доступного шаблона с макросами '---------------------------------------------------------------------- Dim oTemplate As Object 'объект для шаблона из которого будут читаться макросы Dim bLockedProjOpened As Boolean 'флаг для определения состояния шаблона: закрыт он или открыт для чтения For Each oTemplate In Application.templates bLockedProjOpened = False If oTemplate.VBProject.Protection = vbext_pp_locked Then Set oTemplate = Application.Documents.Open(oTemplate.FullName, ReadOnly:=True) bLockedProjOpened = True End If 'Записываем строку, начинающую меню для каждого шаблона. 'Пробелы для идентификаторов заменяем на нижнее подчеркивание. sXML = sXML & vbTab & _ "<menu id=""ID_" & Replace(oTemplate.Name, " ", "_") & IDcounter & """ " & _ "label=""Макросы из «" & oTemplate.Name & "»""> " & vbCr 'Счетчик для идентификаторов IDcounter = IDcounter + 1 'Попытка прочитать имена программных модулей из указанного шаблона On Error Resume Next asModulesNames = fGetModulesNames(oTemplate) 'читаем программные модули из шаблона и записываем их в наш массив 'Если произошла ошибка при чтении модулей, то выводится сообщение и процедура прерывается. If Err.Number <> 0 Then MsgBox "Не удалось прочитать список модулей из " & oTemplate.Name, vbOKOnly, "Ошибка при формировании меню" Err.Clear Exit Sub End If For j = 0 To UBound(asModulesNames) 'Разделитель меню для каждого программного модуля в проекте шаблона. sXML = sXML & vbTab & vbTab & _ "<menuSeparator id=""ID_" & Replace(oTemplate.Name, " ", "_") & IDcounter & """ " & _ "title=""" & asModulesNames(j) & """/> " & vbCr IDcounter = IDcounter + 1 'Попытка прочитать имена функций из указанного шаблона указанного модуля. On Error Resume Next asFuncNames = fGetFuncNames(oTemplate, oTemplate.VBProject.VBComponents(asModulesNames(j))) 'Если произошла ошибка при чтении имен функций, то выводится сообщение и процедура прерывается. If Err.Number <> 0 Then MsgBox "Не удалось прочитать список функций из модуля " & asModulesNames(j) & _ " шаблона " & oTemplate.Name, vbOKOnly, "Ошибка при формировании меню" Err.Clear Exit Sub End If For i = 0 To UBound(asFuncNames) 'Создаем кнопку в меню, которая запускает соответствующий макрос. Путь к макросу записываем в свойство '«tag». При вызове макроса «onAction» свойство «tag» передается в качестве аргумента. Свойство «tag» 'записываем в виде ‹имя_проекта›.‹имя_модуля›.‹имя_макроса›. Это позволяет запускать любые макросы из 'загруженных проектов. sXML = sXML & vbTab & vbTab & _ "<button id=""menubtn_" & asModulesNames(j) & IDcounter & """ " & _ "label=""" & asFuncNames(i) & """ " & _ "tag=""" & oTemplate.VBProject.Name & "." & asModulesNames(j) & "." & asFuncNames(i) & """ " & _ "onAction=""MyButtonAction""" & "/>" & vbCr IDcounter = IDcounter + 1 Next i Next j 'Заканчиваем формирование меню с макросами для данного шаблона sXML = sXML & vbTab & "</menu>" & vbCr 'Проверяем открывался ли закрытый для просмотра документ. Если да, то закрываем его. If bLockedProjOpened Then oTemplate.Close End If Next oTemplate 'Добавляем стандартные кнопки управлением средой Visual Basic через разделитель sXML = sXML & vbTab & _ "<menuSeparator id=""MenuSep2"" title=""Visual Basic for Application""/>" & vbCr & vbTab & _ "<control idMso=""MacroPlay"" showLabel=""false""/>" & vbCr & vbTab & _ "<control idMso=""MacroRecordOrStop"" showLabel=""false""/>" & vbCr & vbTab & _ "<control idMso=""MacroRecorderPause"" showLabel=""false""/>" & vbCr & vbTab & _ "<control idMso=""VisualBasic"" showLabel=""false""/>" & vbCr 'Завершаем формирование меню content = sXML & "</menu>" 'Отладочные строки. Нужны для просмотра готового кода в редакторе XML. При нормальной работе эти строки 'нужно закомментировать. '''''''''''''''''''''''' Selection.InsertAfter content '''''''''''''''''''''''' Selection.Cut |
Итак, что же происходит?
Сначала добавляем кнопку «Обновить». Это, я полагаю, стандартный шаг для любого динамического меню, т.к. его всегда полезно лишний раз обновить.
Затем вставляем разделитель и формируем вложенные меню для каждого шаблона, доступного для документа. Стоит отметить, что этот этап может вызывать некоторую задержку при формировании, т.к. макросы могут читаться из шаблонов, код которых недоступен для просмотра, но доступен для выполнения. Чтобы добраться до макросов такого закрытого шаблона, он временно открывается для чтения, из него читаются макросы, и он тут же закрывается.
В каждом вложенном меню мы создаем разделители меню с названием модуля, а под этим разделителем — макросы из этого модуля.
Полностью сформированный код динамического меню выглядит так (чтобы его получить нужно раскомментировать строки 97 и 98):
| 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 | <menu xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <button id="RefreshDynMenu" label="Обновить" screentip="Обновить содержимое этого меню" supertip="Нажмите для обновления содержимого меню. Это необходимо делать, если вы изменяете проект Visual Basic для данного документа. Или присоединяете новые шаблоны." onAction="RefreshDynMenu_OnAction" imageMso="RecurrenceEdit"/> <menuSeparator id="MenuSep1"/> <menu id="ID_Шаблон_с_панелью_инструментов_и_макросами.dotm0" label="Макросы из «Шаблон с панелью инструментов и макросами.dotm»"> <menuSeparator id="ID_Шаблон_с_панелью_инструментов_и_макросами.dotm1" title="Macroses"/> <button id="menubtn_Macroses2" label="ФормулаСНумерацией" tag="ПроектСМакросамиИЛентой.Macroses.ФормулаСНумерацией" onAction="MyButtonAction"/> <button id="menubtn_Macroses3" label="ВзятьВКавычки" tag="ПроектСМакросамиИЛентой.Macroses.ВзятьВКавычки" onAction="MyButtonAction"/> <button id="menubtn_Macroses4" label="УвеличитьШрифт" tag="ПроектСМакросамиИЛентой.Macroses.УвеличитьШрифт" onAction="MyButtonAction"/> <button id="menubtn_Macroses5" label="УменьшитьШрифт" tag="ПроектСМакросамиИЛентой.Macroses.УменьшитьШрифт" onAction="MyButtonAction"/> <button id="menubtn_Macroses6" label="СделатьРимскойЦифрой" tag="ПроектСМакросамиИЛентой.Macroses.СделатьРимскойЦифрой" onAction="MyButtonAction"/> </menu> <menu id="ID_Normal.dotm7" label="Макросы из «Normal.dotm»"> <menuSeparator id="ID_Normal.dotm8" title="ThisDocument"/> <button id="menubtn_ThisDocument9" label="Формула_с_нумерацией" tag="Normal.ThisDocument.Формула_с_нумерацией" onAction="MyButtonAction"/> <button id="menubtn_ThisDocument10" label="ВзятьВКавычки" tag="Normal.ThisDocument.ВзятьВКавычки" onAction="MyButtonAction"/> <button id="menubtn_ThisDocument11" label="УвеличитьШрифт" tag="Normal.ThisDocument.УвеличитьШрифт" onAction="MyButtonAction"/> <button id="menubtn_ThisDocument12" label="УменьшитьШрифт" tag="Normal.ThisDocument.УменьшитьШрифт" onAction="MyButtonAction"/> <menuSeparator id="ID_Normal.dotm13" title="NewMacros"/> <button id="menubtn_NewMacros14" label="BigCardText" tag="Normal.NewMacros.BigCardText" onAction="MyButtonAction"/> <button id="menubtn_NewMacros15" label="EndOfWord" tag="Normal.NewMacros.EndOfWord" onAction="MyButtonAction"/> <button id="menubtn_NewMacros16" label="СделатьРимскойЦифрой" tag="Normal.NewMacros.СделатьРимскойЦифрой" onAction="MyButtonAction"/> <button id="menubtn_NewMacros17" label="Макрос2" tag="Normal.NewMacros.Макрос2" onAction="MyButtonAction"/> </menu> <menuSeparator id="MenuSep2" title="Visual Basic for Application"/> <control idMso="MacroPlay" showLabel="false"/> <control idMso="MacroRecordOrStop" showLabel="false"/> <control idMso="MacroRecorderPause" showLabel="false"/> <control idMso="VisualBasic" showLabel="false"/> </menu> |
Как видно из этого кода в свойстве tag прописан полный путь к макросу, что позволяет его запускать из любого открытого документа.
Естественно, что для вашего случая код динамического меню будет другой.
Комментариев нет :
Отправить комментарий