Элемент управления dynamicMenu

Я уже рассказывал о динамических меню ранее:

1. Динамические меню
2. Динамические меню (продолжение)
3. Динамические меню (продолжение 2)
4. Динамические меню (продолжение 3)

Сегодня я подведу итог и представлю окончательный результат.

Для более полной картины нижеописанного рекомендую ознакомиться с прекрасными материалами на эту тему: Урок 12. Динамическое меню, Урок 8. Динамические атрибуты. Тем более, что, судя по содержанию, толчком для этих материалов, в какой-то мере, был и мой блог.

Итак, в предыдущих постах я рассказывал о создании динамического меню для управления закладками. Задача состояла в создании меню с такими возможностями:

• Отображение количества закладок в документе;
• Включение / выключение маркеров закладок;
• Переход к закладке;
• Добавление / удаление закладок

В принципе, всё это было реализовано в предыдущей версии. По мере использования, возникла потребность быстро вставлять перекрёстную ссылку, а также выявились ошибки. Решив внести коррективы, я всё подверг переработке. Меню добавляется на вкладку «Надстройки» и выглядит в Xml так:

  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 
<?xml version="1.0" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="LoadRibbon">
    <ribbon startFromScratch="false">
        <tabs>
            <tab idMso="TabAddIns">
                <group id="idManageBookmarks" label="Управление закладками">
                    <dynamicMenu id="dmBookmark"
                                 getLabel="dmBookmark_getLabel"
                                 getEnabled="dmBookmark_getEnabled"
                                 getContent="dmBookmark_getContent"/>
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Меню в документе без закладок

Меню в документе с двумя закладками

Как видно по 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 
 99 
100 
101 
102 
103 
104 
105 
106 
107 
108 
109 
110 
111 
112 
113 
114 
115 
116 
117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 
140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 
151 
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 
211 
212 
213 
214 
215 
216 
217 
218 
219 
220 
221 
222 
223 
224 
225 
226 
227 
228 
229 
230 
231 
232 
233 
234 
235 
236 
237 
238 
239 
240 
241 
242 
243 
244 
245 
246 
247 
248 
249 
250 
251 
252 
253 
254 
255 
256 
257 
258 
259 
260 
261 
262 
263 
264 
265 
266 
267 
Option Explicit

Public CustomRibbon As IRibbonUI
Private AppEv As AppEvents

Private Const CUSTOMUINS2007 As String = "http://schemas.microsoft.com/office/2006/01/customui"
Private Const CUSTOMUINS2010 As String = "http://schemas.microsoft.com/office/2009/07/customui"

Private bSortByABC As Boolean 'Режим сортировки
Dim bookmarksSet As bookmarks 'Коллекция закладок документа. Состав коллекции зависит от bSortByABC

' (компонент: customUI, атрибут: onLoad), 2007
Sub LoadRibbon(ribbon As IRibbonUI)
'
'Загрузка ленты
'
  Set AppEv = New AppEvents
  Set AppEv.App = Application
  Set CustomRibbon = ribbon
  Set AppEv.rib = CustomRibbon
  CustomRibbon.Invalidate
End Sub

'dmBookmark (компонент: dynamicMenu, атрибут: getLabel), 2007
Sub dmBookmark_getLabel(control As IRibbonControl, ByRef label)
  On Error Resume Next

  If Not CBool(Documents.Count) Then
    label = "Закладки"
  Else
    Set bookmarksSet = IIf(bSortByABC, ActiveDocument.bookmarks, ActiveDocument.content.bookmarks)
    label = "Закладки" & IIf(ActiveDocument.bookmarks.Count <> 0, " (" & bookmarksSet.Count & ")", "")
  End If
End Sub

'dmBookmark (компонент: dynamicMenu, атрибут: getEnabled), 2007
Sub dmBookmark_getEnabled(control As IRibbonControl, ByRef enabled)
  enabled = Documents.Count <> 0
End Sub

'dmBookmark (компонент: dynamicMenu, атрибут: getContent), 2007
Sub dmBookmark_getContent(control As IRibbonControl, ByRef content)
'
'Формирование меню с закладками документа
'
  Dim sXML As String 'Строка, в которую записывается XML-код динамического меню
  'Разные источники для получения списка закладок в зависимости от выбранного типа сортировки в меню
  'Коллекция ActiveDocument.Bookmarks дает список закладок по алфавиту,
  'а ActiveDocument.Content.Bookmarks — по положению в документе.
  Dim BookmarksCount As Long
  If Not ActiveDocument Is Nothing Then
    Set bookmarksSet = IIf(bSortByABC, ActiveDocument.bookmarks, ActiveDocument.content.bookmarks)
    BookmarksCount = bookmarksSet.Count
  Else: BookmarksCount = 0
  End If
  Select Case Val(Application.Version)
    Case 12
      sXML = "<menu xmlns=""" & CUSTOMUINS2007 & """>" & vbCr
    Case 14, 15
      sXML = "<menu xmlns=""" & CUSTOMUINS2010 & """>" & vbCr
  End Select
'--------------------------
'Кнопка «Обновить»
'--------------------------
  sXML = sXML & _
    "<button id=""idRefresh"" " & _
    "label=""Обновить"" " & _
    "onAction=""idRefresh_OnAction"" " & _
    "imageMso=""RecurrenceEdit""/>" & vbCr
'--------------------------
'Кнопка-переключатель «Отобразить закладки»
'--------------------------
  sXML = sXML & _
    "<toggleButton id=""idShowHide"" " & _
    "supertip=""Выбор этой команды приведет к отображению или скрытию меток закладок в документе"" " & _
    "imageMso=""DataGraphicIconSet"" " & _
    "getPressed=""idShowHide_getPressed"" " & _
    "getLabel=""idShowHide_getLabel"" " & _
    "onAction=""idShowHide_onAction"" />" & vbCrLf
'--------------------------
'Кнопка-переключатель «Сортировать по алфавиту»
'--------------------------
  sXML = sXML & _
    "<toggleButton id=""idSort"" " & _
    "supertip=""Сортировка списка закладок по алфавиту либо по положению в документе&#13;При отображении списка закладок по алфавиту отображаются также и закладки, которые находятся в надписях, колонтитулах, сносках и прочих структурных элементах документа.&#13;При отображении закладок по положению отображаются только закладки, находящиеся в теле документа"" " & _
    "imageMso=""SortUp"" " & _
    "getPressed=""idSort_getPressed"" " & _
    "getLabel=""idSort_getLabel"" " & _
    "onAction=""idSort_onAction"" />" & vbCrLf
'--------------------------
'Кнопка «Добавить закладку
'--------------------------
  sXML = sXML & _
    "<button id=""idAddBookmark"" " & _
    "label=""Добавить"" " & _
    "imageMso=""OutlineExpand"" " & _
    "onAction=""idAddBookmark_onAction""/>" & vbCrLf
'--------------------------
'Меню «Перекрёстные ссылки»
'--------------------------
  sXML = sXML & _
      "<menu id=""idInsertCrossRef"" " & _
      "getVisible=""Menu_getVisible"" " & _
      "label=""Перекрёстные ссылки"">" & vbCr
'--------------------------
'Кнопки для вставки перекрёстных ссылок на закладки
'------------------------
  sXML = sXML & GetButtonsForBookmarks(BookmarksCount, "idCrossRef", "idInsertCrossRef_onAction", "CrossReferenceInsert") & _
    "</menu>" & vbCr 'Закрывающий тэг меню перекрёстных ссылок
'--------------------------
'Меню «Удаление»
'--------------------------
  sXML = sXML & _
      "<menu id=""idDeleteBookmarks"" " & _
      "getVisible=""Menu_getVisible"" " & _
      "label=""Удалить (" & BookmarksCount & ")"" >" & vbCr
'--------------------------
'Кнопки Удаления закладок
'------------------------
  sXML = sXML & GetButtonsForBookmarks(BookmarksCount, "idDeleteBookmarks", "idDeleteBookmarks_onAction", "OutlineCollapse")
  sXML = sXML & "</menu>" & vbCr 'Закрывающий тэг меню удаления закладок
  If BookmarksCount <> 0 Then
'--------------------------
'Кнопки с именами закладок
'--------------------------
    sXML = sXML & "<menuSeparator id=""MenuSep1"" title=""Закладки в документе""/>" & vbCr
    sXML = sXML & GetButtonsForBookmarks(BookmarksCount, "idBookmark", "idBookmark_onAction", "FrontPageToggleBookmark")
  End If
  content = sXML & "</menu>" 'закрываем динамическое меню
'Отладочные строки. Нужны для просмотра готового кода в редакторе XML. При нормальной работе эти строки
'нужно закомментировать.
'  Selection.InsertAfter content
'  Selection.Cut
'  CopyTextToClipboard content
End Sub

Sub idBookmark_onAction(control As IRibbonControl)
'
'Переход к закладке
'
  On Error Resume Next
  Selection.GoTo What:=wdGoToBookmark, Name:=control.Tag
  If Err.Number <> 0 Then
    MsgBox "Не удалось перейти к закладке «" & control.Tag & "»", vbOKOnly
  End If
End Sub

Sub idRefresh_OnAction(control As IRibbonControl)
'
'Обновление динамического меню
'
  CustomRibbon.InvalidateControl control.id
End Sub

Sub idAddBookmark_onAction(control As IRibbonControl)
'
'Появление окна для добавления закладки в документ
'
  Dialogs(wdDialogInsertBookmark).Show
  CustomRibbon.Invalidate
End Sub

Sub idDeleteBookmarks_onAction(control As IRibbonControl)
'
'Удаление закладки при выборе ее в соответствующем меню
'
  bookmarksSet.Item(control.Tag).Delete
  CustomRibbon.InvalidateControl control.id
End Sub

Sub idInsertCrossRef_onAction(control As IRibbonControl)
'
'Вставка перекрёстной ссылки на закладку
'
    Selection.InsertCrossReference WdReferenceType.wdRefTypeBookmark, wdContentText, bookmarksSet.Item(control.Tag).Name, True
End Sub

Sub idShowHide_getPressed(control As IRibbonControl, ByRef returnedVal)
'
'Нажатое/отжатое состояние кнопки для отображения/скрытия закладок в документе
'
  If Not ActiveDocument.ActiveWindow Is Nothing Then returnedVal = ActiveDocument.ActiveWindow.View.ShowBookmarks
End Sub

Sub idShowHide_getLabel(control As IRibbonControl, ByRef returnedVal)
'
'Замена текста кнопки для скрытия/отображения закладок в документе
'
  returnedVal = IIf(ActiveDocument.ActiveWindow.View.ShowBookmarks, "Скрыть закладки", "Отобразить закладки")
  CustomRibbon.Invalidate
End Sub

Sub idShowHide_onAction(control As IRibbonControl, pressed As Boolean)
'
'Отображение/скрытие закладок в документе
'
  ActiveDocument.ActiveWindow.View.ShowBookmarks = Not ActiveDocument.ActiveWindow.View.ShowBookmarks
End Sub

Sub idSort_getPressed(control As IRibbonControl, ByRef returnedVal)
'
'Сортировка списка закладок по алфавиту или по положению в документе
'
  returnedVal = bSortByABC
End Sub

Sub idSort_onAction(control As IRibbonControl, pressed As Boolean)
'
'Сортировка списка закладок по алфавиту или по положению в документе
'
  bSortByABC = pressed
End Sub

Sub idSort_getLabel(control As IRibbonControl, ByRef returnedVal)
'
'Сортировка списка закладок по алфавиту или по положению в документе
'
  returnedVal = IIf(bSortByABC, "Сортировать по положению", "Сортировать по алфавиту")
End Sub

Sub Menu_getVisible(control As IRibbonControl, ByRef returnedVal)
'
'Видимость меню удаления закладок и перекрёстных ссылок
'
  returnedVal = bookmarksSet.Count <> 0
End Sub

Private Function GetRightXMLString(ByVal str As String) As String
'
'Замена в строке XML спецсимволов на их коды
'
  Dim ar(), i%
  ar = Array("""", "<", ">", "[", "]", "'", "-", vbTab, vbCr, vbCrLf, vbLf)
  str = Replace(str, vbCr & ChrW(7), "")
  For i = 0 To UBound(ar)
    str = Replace(str, ar(i), "&#" & Asc(ar(i)) & ";")
  Next
  GetRightXMLString = str
End Function

Private Function GetButtonsForBookmarks(BookmarksCount As Long, id As String, macro As String, imageMso As String)
'
'Функция, генерирующая строку XML для добавления в динамическое меню кнопок для работы с отдельными закладками
'Указать нужно количество закладок, строку для постоянной части идентификатора, имя макроса, который будет вызы-
'ваться при нажатии на кнопку и имя картинки
'Созданную строку нужно присоединить к содержимому динамического меню
'
  Dim i As Integer
  Dim sExtString As String
  Dim sXML As String
  For i = 1 To BookmarksCount
    If Len(bookmarksSet.Item(i).Range.Text) <= 10 Then
      sExtString = GetRightXMLString(Left(bookmarksSet.Item(i).Range.Text, 10)) & ")" & """ "
    Else
      sExtString = GetRightXMLString(Left(bookmarksSet.Item(i).Range.Text, 10) & "…") & ")" & """ "
    End If
    sXML = sXML & _
      "<button id=""" & id & i & """ " & _
      "label=""" & bookmarksSet.Item(i).Name & " (" & sExtString & _
      "onAction=""" & macro & """ " & _
      "imageMso=""" & imageMso & """ " & _
      "supertip=""" & Left(GetRightXMLString(IIf(Len(bookmarksSet.Item(i).Range.Text) > 0, bookmarksSet.Item(i).Range.Text, "<<Нет текста>>")), 1023) & """ " & _
      "screentip=""" & "Закладка " & i & """ " & _
      "tag=""" & bookmarksSet.Item(i).Name & """ />" & vbCr
  Next i
  GetButtonsForBookmarks = sXML
End Function

Так же для реагирования на события приложения нужен класс:

  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 
 16 
 17 
 18 
 19 
 20 
 21 
 22 
 23 
 24 
Option Explicit

Public WithEvents App As Word.Application
Public rib As IRibbonUI

Private Sub App_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)

End Sub

Private Sub App_DocumentChange()
  rib.Invalidate
End Sub

Private Sub App_DocumentOpen(ByVal Doc As Document)
  rib.Invalidate
End Sub

Private Sub App_NewDocument(ByVal Doc As Document)
  rib.Invalidate
End Sub

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
  rib.Invalidate
End Sub

Работу с событиями приложения я описывал в посте Обработка событий на уровне приложения. В приведённом классе лента обновляется при:

1. закрытии документа (App_DocumentBeforeClose);
2. открытии документа (App_DocumentOpen);
3. создании нового документа (App_NewDocument);
4. переключении между открытыми документами (App_DocumentChange);
5. смене выделения (App_WindowSelectionChange).

Благодаря этим событиям, динамическое меню становится действительно динамическим.

Разберём подробно код VBA. В строке 4 объявляется объект AppEv для событий приложения. Инициализируется этот объект в строке 17 в при загрузке ленты.

В строках 6, 7 задаются строковые константы пространств имён для разных версий Word.

Строки 13 – 22 — это событие загрузки формы. В нём создаётся новый объект AppEv для событий приложения (17 строка), задаётся приложение, на события которого нужно реагировать (строка 18), запоминается лента (строка 19) и ссылка на ленту передаётся в AppEv (строка 20).
Строка 38 — меню будет активно, если открыт хотя бы один документ.
Обратите внимание на строки 56 – 61. Здесь, в зависимости от версии приложения, подставляется соответствующее пространство имён в заголовок меню. В своё время я долго не мог выловить ошибку, возникшую из-за того, что в Xml-схеме документа было пространство имён для 2010 – 2013 офиса, а в динамическое меню подставлялось старое пространство имён от 2007 версии. Это очень важный момент, который следует иметь ввиду, если предполагается использование шаблона в разных версиях Word.
Далее формирование самого динамического меню. Оно достаточно подробно прокомментировано в коде. Я лишь хочу обратить внимание, что для трёх наборов кнопок (вставка перекрёстной ссылки, удаление закладки и переход к закладке) xml-код формируется отдельной функцией GetButtonsForBookmarks (строки 241 – 267).

Готовый шаблон для работы с закладками