Тихвинский Виталий
VBA Создание меню

Содержание

• Типы меню приложений
• Обращение к меню
• Создание пустого меню
• Вывод меню
• Удаление меню
• Добавление пунктов в меню
• Свойства и методы пунктов меню
• Переключатель в пункте меню
• Коды пиктограмм пункта меню
• Односеансное контекстное меню
• Назначение управляющих клавиш к пункту меню
• Назначение управляющих клавиш макросам через меню приложений
• Программное назначение управляющих клавиш макросам

Типы меню приложений

Внутри приложений Word и Excel существует три типа меню:

• Головное меню – меню, которое выводится по умолчанию вверху окна приложения, выше всех других меню.
• Контекстное меню – меню, которое появляется при нажатии правой клавиши мыши на каком либо объекте (в частности на документе Word или книги Excel).
• Панель инструментов – меню, которое можно включить и выключить через стандартные пункты головного меню: Вид-Панель Инструментов.

Обращение к меню

Обращение к меню происходит через объекты CommandBars и ActiveMenuBar. Ниже приведены примеры обращения к свойству Index меню с именем “text” и к головному активному меню приложения:

Ind = Application.CommandBars(“Text”).index
Ind = Application.CommandBars.ActiveMenuBar.index

Создание пустого меню

Меню можно создать методом add объекта CommandBars.
Ниже приведены два примера создание головного и контекстного меню:

Application.CommandBars.Add Name:="Имя головного меню", _
MenuBar:=True, temporary:=True
Application.CommandBars.Add "Имя контекстного меню", msoBarPopup

Вывод меню

Головное меню пользователя можно вывести через свойство Visible, а контекстное меню через метод ShowPopup. Если пользователь создал головное меню и вывел его, то оно заменяет стандартное меню приложения и существует пока приложение не закрыли, или пока это меню не удалили.

Пример:

Application.CommandBars("Имя контекстного меню").ShowPopup 
Application.CommandBars("Имя главного меню").Visible = True

Удаление меню

Меню пользователя можно удалить через свойство Delete. Через свойство Reset можно очистить меню пользователя или меню приложения от добавленных пунктов.

Пример:

Application.CommandBars("Имя меню").Delete 

Добавление пунктов в меню

Пункт в меню добавляется методом Add объекта Controls, который является потомком объектов CommandBars и ActiveMenuBar.

Пример:

With  CommandBars("Имя меню")
 ‘Установка указателя на объект добавляющий пункт меню
 Set mButton = .Controls.Add(Type:=msoControlButton, ID:=850)
 With mButton
  ‘задание свойств пункта меню
  .Caption = ”Мой пункт”
  .OnAction = ”МойПункт” 
 End with 
End with

Private Sub ДанныеМеню(s As String, Группа As Boolean, _
Пиктограмма As String, ИмяСобытия, Подпись, id1 As Long)

Dim s1 As String, i as long
If InStr(s, ",") <> 0 Then
s1 = Mid(s, InStr(s, ",") + 1)
s = Mid(s, 1, InStr(s, ",") - 1)
Else
s1 = ""
End If
If Mid(s, 1, 1) = "_" Or Mid(s, 1, 1) = "-" Then
s = Mid(s, 2)
Группа = True
Else
Группа = False
End If
Пиктограмма = ""
While Mid(s, 1, 1) >= "0" And Mid(s, 1, 1) <= "9"
Пиктограмма = Пиктограмма + Mid(s, 1, 1)
s = Mid(s, 2)
Wend
If InStr(s, ";") <> 0 Then
ИмяСобытия = Mid(s, 1, InStr(s, ";") - 1)
Подпись = Mid(s, InStr(s, ";") + 1)
Else
ИмяСобытия = ""
For i = 1 To Len(s)
If Mid(s, i, 1) <> "&" And Mid(s, i, 1) <> " " Then
 ИмяСобытия = ИмяСобытия + Mid(s, i, 1)
End If
Next i
Подпись = s
End If
If Подпись <> "" Then
If Mid(Подпись, Len(Подпись), 1) = " " Then
id1 = 850
Else
id1 = 1
End If
End If
Подпись = RTrim(Подпись)
s = s1
End Sub

Private Sub Добавление(Mbar, ByVal s As String)
Dim mButton As Variant, Пункт As Long, i As Long
Dim Пиктограмма As String, Группа As Boolean
Dim ИмяСобытия, Подпись, id1 As Long
 
ДанныеМеню s, Группа, Пиктограмма, ИмяСобытия, Подпись, id1
With Mbar
For i = 1 To 850 Step 849
If s = "" Then
Set mButton = .Controls.Add(Type:=msoControlButton, ID:=i)
Else
Set mButton = .Controls.Add(Type:=msoControlPopup)
End If
  With mButton
     Пункт = .Index
     .Caption = Подпись
    If i = 1 Then
     .BeginGroup = Группа
    End If
If s = "" Then
     .OnAction = ИмяСобытия
    If Пиктограмма <> "" Then
     .FaceId = Val(Пиктограмма)
    End If
  If i = id1 Then
   .Visible = True
   Else
      .Visible = False
  End If
Else
   Exit For
End If
  End With
 Подпись = Подпись + " "
Next i
End With

While s <> ""
ДанныеМеню s, Группа, Пиктограмма, ИмяСобытия, Подпись, id1
With Mbar.Controls(Пункт)
For i = 1 To 850 Step 849
Set mButton = .Controls.Add(Type:=msoControlButton, ID:=i)
  With mButton
     .Caption = Подпись
     .OnAction = ИмяСобытия
 If i = 1 Then
  .BeginGroup = Группа
 End If
    If Пиктограмма <> "" Then
     .FaceId = Val(Пиктограмма)
    End If
    If i = id1 Then
   .Visible = True
   Else
   .Visible = False
  End If
  End With
 Подпись = Подпись + " "
Next i
End With
Wend
End Sub
 

Sub ДобавитьПункты(ИмяМеню, ParamArray ПунктыМеню())
Dim m As Variant, Mbar As Variant
If ИмяМеню = "" Then
ИмяМеню = Application.CommandBars.ActiveMenuBar.Name
End If
Set Mbar = Application.CommandBars(ИмяМеню)
For Each m In ПунктыМеню
Добавление Mbar, m
Next m
End Sub

Sub ДобавитьПункты2(ИмяМеню, ПунктМеню1, ParamArray ПунктыМеню())
Dim m As Variant, Mbar As Variant, Index As Long
Dim Пиктограмма As String, Группа As Boolean
Dim ИмяСобытия, Подпись, id1 As Long
If ИмяМеню = "" Then
ИмяМеню = Application.CommandBars.ActiveMenuBar.Name
End If
Set Mbar = Application.CommandBars(ИмяМеню)
With Mbar
ДанныеМеню (ПунктМеню1), Группа, Пиктограмма, ИмяСобытия, Подпись, id1
   With .Controls.Add(Type:=msoControlPopup)
     Index = .Index
     .Caption = Подпись
     .BeginGroup = Группа
  End With
End With
Set Mbar = Application.CommandBars(ИмяМеню).Controls(Index)
For Each m In ПунктыМеню
Добавление Mbar, m
Next m
End Sub

1. Необходимо задать имя меню. Если параметр ИмяМеню процедуры добавляющей пункты имеет значение пустой строки, то пункты добавляются в головное меню приложения.
   Имена стандартных контекстных меню приложения Word следующие:
   • "Text" -контекстное меню на выделенном тексте
   • "Curve" - контекстное меню на выделенных линиях
   • "Shapes" - контекстное меню на выделенных автофигурах
2. Необходимо ввести имена событий в строковом формате через запятую.
3. Имя события не должно содержать пробелов и символа &.
4. Если нужно записать и имя события пункта меню, и подпись пункта меню их разделяют точкой с запятой.
5. Если во введенном имени события содержатся пробелы и символ &, то эти символы автоматически удаляются из имени события, и если не указана подпись пункта меню, то в подпись пункта меню передается имя события с запретными символами.
6. Перед именем события пункта меню можно ввести цифры, которые зададут код пиктограммы пункта меню(см. Коды пиктограмм пунктов меню). Но пункт меню, который имеет подпункты, не может иметь пиктограммы.
7. Перед именем события пункта меню и перед цифрами задающими пиктограмму пункта меню можно ввести символ подчеркивания “_”, или символ минус “-”, при этом пункт меню будет отделен от других пунктов разделительной линией.
8. Если необходимо подчеркнуть букву подписи, перед ней ставят символ &
9. Если необходимо пометить пункт меню то подпись пункта меню должна заканчиваться пробелом (пункт меню, который имеет подпункты, не может быть выделен).
10. Во входных параметрах ПунктыМеню могут иметься подпункты, которые отделяются от основного пункта меню запятой.
11. Процедурой ДобавитьПункты можно добавить несколько пунктов первого уровня, и подпункты к ним. Процедурой ДобавитьПункты2 можно добавить только один пункт первого уровня (за один запуск данной процедуры), но к этому пункту можно добавить подпункты как второго, так и третьего уровня.
12. Перед добавлением пунктов меню необходимо создать внутри проекта, из которого добавляются пункты меню, модуль общих подпрограмм, который будет содержать в себе процедуры, имена которых совпадают с именами событий пунктов меню(для пунктов меню, которые имеют подпункты, их задавать не требуется, так как процедуры ДобавитьПункты не задают соответствующие свойство OnAction для данных пунктов меню. см. Свойства и методы пунктов меню).
    
    Пример:

    ‘Добавление пунктов в стандартное контекстное меню “Text” приложения Word
    ДобавитьПункты2 "Техt", "Первый", _
    "ВторойПункт;Второй пункт 1,ДТретий", "-3Третий"
    

    
    
    Рис. 1 Последние добавленные пункты в контекстное меню “Text”

    
    Примечание:
    Если вы хотите добавить в меню подпункты четвертого и далее уровня, то вам необходимо дорастить пункт меню третьего уровня односеансным контекстным меню (см. Односеансное контекстное меню)

Свойства и методы пунктов меню

Для обработки пунктов меню применяются свойства и методы объекта Controls. Для удаление пункта меню метод Delete, для скрытия и отображения пункта меню иcпользуют свойство Visible, для запрещения и разрешения пунктов меню свойство - Enabled. Для создание разделительной линии перед пунктом меню свойство - BeginGroup. Свойство Visible, Enabled и BeginGroup имеют значение соответственно True если меню видно и активно и отделено от других пунктов разделительной линией, и False если меню скрыто и не активно и не имеет разделительной линии. Для пунктов меню, которые не имеют подпунктов, через свойство FaceId можно задать код пиктограммы меню (см. Коды пиктограмм пунктов меню).
Если пункт меню не имеет подпунктов, то этому пункту можно задать свойство Controls.ShortcutText, которое выводит справа от подписи пункта текст, сообщающий о том, комбинация каких управляющих клавиш назначена для данного пункта меню (см. Назначение управляющих клавиш к пункту меню).
Через свойство OnAction можно задать имя процедуры, которая не имеет входных параметров. Данная процедура будет срабатывать при клике левой клавишей мыши по соответствующему пункту меню.
Если пункт меню скрыт, но свойство пункта меню BeginGroup имеет значение True, то разделительная линия скрытого пункта меню видна над последующим, за ним пунктами.
Можно удалять и скрывать пункты, начиная с первого уровня, при удалении и скрытии верхнего уровня, все подпункты меню расположенные в удаляемом пункте удаляются и скрываются вместе с ним.
Во входном параметре объекта Controls записывается либо подпись пункта меню, либо его индекс.
Подпрограммы ДобавитьПункты (см. Добавление пунктов меню) добавляют по два пункта меню (не помеченный пункт меню, и однотипный ему - помеченный). Причем в меню виден только один из вышеуказанных пунктов. Не помеченный пункт меню имеет подпись без пробела в конце, а помеченный не имеет пробел, завершающий подпись (на стандартные пункты меню это правило не распространяется).

Пример:

‘Удаление пункта меню первого уровня
CommandBars.ActiveMenuBar.Controls("Подпись пункта").Delete

‘Скрытие пункта меню второго уровня помеченного галочкой
Application.CommandBars.ActiveMenuBar.Controls( _
"Подпись пункта первого уровня").Controls( _
"Подпись пункта второго уровня ").Visible =false

‘В третий подпункт меню добавлено сообщение о том, какая комбинация управляющих
‘клавиш назначена данному пункту 
CommandBars.ActiveMenuBar.Controls("первый").Controls( _
"Второй пункт").Controls("Третий").Control.ShortcutText = "CTRL+M"

Переключатель в пункте меню

В пункте меню, который не имеет подпунктов, можно установить переключатель.
Подпрограммы ДобавитьПункты (см. Добавление пунктов меню) добавляют по два пункта меню (не помеченный пункт меню, и однотипный ему - помеченный). Причем в меню виден только один из вышеуказанных пунктов. Не помеченный пункт меню имеет подпись без пробела в конце, а помеченный не имеет пробел, завершающий подпись. Поэтому, необходимо менять в событийной процедуре этих пунктов меню свойство Visible на обратное:

‘переключатель пункта меню второго уровня
Sub Два()
With Application.CommandBars.ActiveMenuBar.Controls("мой")
.Controls("два").Visible = Not .Controls("два").Visible
.Controls("два ").Visible = Not .Controls("два ").Visible
End With
End Sub

‘переключатель пункта меню третьего уровня
Sub W()
With Application.CommandBars.ActiveMenuBar.Controls("мой").Controls("о&дин")
.Controls("w").Visible = Not .Controls("w").Visible
.Controls("w ").Visible = Not .Controls("w ").Visible
End With
End Sub

With Application.CommandBars.ActiveMenuBar.Controls(“Первый уровень”)
If .Controls(“Второй уровень“ + “ “).visible =  true then
‘Переключатель включен
Else
‘Переключатель выключен
End If
End with

Коды пиктограмм пункта меню

 
Sub FaceIdPicture()
Dim i As Long, k As Long, n As Byte
Dim mButton As CommandBarButton
k = 1
Do
n = 0
Set MBar = Application.CommandBars.Add(, msoBarPopup)
With MBar
For i = 1 To 26
n = n + 1
 Set mButton = .Controls.Add(Type:=msoControlButton)
  With mButton
    If i = 26 Then
     .Caption = "Выход"
     .OnAction = "Выход"
     Else
      .Caption = CStr(k)
      If  k  <= 3518 Then
     .FaceId = k
      k = k + 1 
    End If
    End If
  End With
Next i
  .ShowPopup
 .delete
End With
Loop Until k > 3518
End Sub


Sub выход()
End
End Sub 

Односеансное контекстное меню

Можно создать односеансное контекстное меню. Такое меню наиболее удобно внутри приложения Excel. Т.к. в данном приложении лист Excel имеет событие, которое отлавливает нажатие правой клавиши мыши на нем. Что позволяет заблокировать вывод стандартного контекстного меню, и вывести вместо него свое. К сожалению, документ Word не имеет такого события, и в приложении Word возможно только добавление пунктов в стандартные контекстные меню. Поэтому в приложении Word функцию СоздатьКонтекстноеМеню можно запускать только как процедуру, для продолжения подпунктов меню третьего уровня (О чем рассказано в конце данной главы).
Для того, что бы заблокировать контекстное меню на листе Excel необходимо в модуле соответствующего листа, в событийной процедуре BeforeRightClick установить значение входного параметра Cansel на True. Через свойства Column и Row обьекта Target можно заблокировать вывод стандартного контекстного меню в определенной области листа.

Пример:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Target.Column <= 2 And Target.Row <= 4 Then
Cancel = True
End If
End Sub

Function СоздатьКонтекстноеМеню(ParamArray ПунктыМеню())
Dim mButton As Variant, m As Variant, Mbar As Variant
Dim n As Long, Пиктограмма As String, Группа As Boolean
Dim s As String, ИмяСобытия, Подпись, id1 As Long
Set Mbar = Application.CommandBars.Add(, msoBarPopup)
For Each m In ПунктыМеню
s = m
ДанныеМеню s, Группа, Пиктограмма, ИмяСобытия, Подпись, id1
With Mbar
If s = "" Then
Set mButton = .Controls.Add(Type:=msoControlButton, ID:=id1)
Else
Set mButton = .Controls.Add(Type:=msoControlPopup)
End If
  With mButton
     .Caption = Подпись
    If s = "" Then
     .OnAction = ИмяСобытия
    If Пиктограмма <> "" Then
     .FaceId = Val(Пиктограмма)
    End If
   End If
 .BeginGroup = Группа
 n = .Index
  End With
End With

While s <> ""
ДанныеМеню s, Группа, Пиктограмма, ИмяСобытия, Подпись, id1
With Mbar.Controls(n)
Set mButton = .Controls.Add(Type:=msoControlButton, ID:=id1)
  With mButton
     .Caption = Подпись
     .OnAction = ИмяСобытия
 .BeginGroup = Группа
    If Пиктограмма <> "" Then
     .FaceId = Val(Пиктограмма)
    End If
  End With
End With
Wend
Next m

Mbar.ShowPopup
 СоздатьКонтекстноеМеню = True
 Mbar.Delete
End Function

‘событийная процедура внутри модуля листа
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, _
Cancel As Boolean)
 If flag = False Then
   Cancel = СоздатьКонтекстноеМеню("Мой пункт")
 Else
   Cancel = СоздатьКонтекстноеМеню("Мой пункт ")
 End If
End Sub

‘программный код внутри модуля общих подпрограмм проекта
‘в котором находится соответствующий лист
Public flag As Boolean
Sub МойПункт()
flag = Not flag
End Sub

‘событийная процедура внутри модуля листа
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, _
Cancel As Boolean)
Cancel = CоздатьКонтекстноеМеню( _
"ПервыйУровень,186ВторойУровень1,ВторойУровень2")
End Sub


‘программный код внутри модуля общих подпрограмм проекта
‘в котором находится соответствующий лист
Sub ВторойУровень1()
 СоздатьКонтекстноеМеню "Третий Уровень1", "Третий Уровень2"
End Sub

Рис 2. Контекстное меню пользователя после выбора пункта ПервыйУровень

Рис 3. Контекстное меню пользователя после выбора пункта ВторойУровень1

Назначение управляющих клавиш к пункту меню

Т.к. пункт меню через свойство OnAction может быть связан с процедурой не имеющей входных параметров, а процедура без входных параметров в VBA для Word и Excel является макросом, то назначение управляющих клавиш для соответствующих макросов, соответствует назначению управляющих клавиш для пунктов меню, которые закреплены за ними.
Управляющие клавиши для макросов могут быть назначены через меню приложения и программно.

Назначение управляющих клавиш макросам через меню приложений

В программе Word управляющие клавиши назначаются следующим образом:

1. Войти в меню: Вид-Панель Инструментов-Настройка
2. В окне “Настройка” выбрать закладку “Команды” и кнопку “Клавиатура…” см. Рис 4.

   
   Рис. 4
   
   

3. В появившемся окне в разделе “Категории:” выбрать – Макросы. В разделе “Макросы:” выбрать имя того макроса, в которому назначается горячая клавиша. В разделе “Сохранить изменения в…” выбрать тот документ, в котором сохранятся назначенные горячие клавиши к макросу. см Рис. 5.
4. Перейти в пункт: “Новое сочетание клавиш”
5. Нажать необходимую комбинацию управляющих клавиш.
6. Закрыть окно для назначения управляющих клавиш.

Рис. 5 Назначение управляющих клавиш в Word

В программе Excel управляющие клавиши назначаются следующим образом:

1. Войти в меню: Сервис-Макрос-Макросы
2. В появившемся окне выбрать необходимое имя макроса и нажать кнопку “Параметры…” Рис 6.

   
   Рис 6

   
   
   
3. В появишемся окне в перейти в раздел “сочетание клавиш” см. рис 7.
4. В разделе “сочетание клавиш” в режиме погашеного Caps Loock (прописные буквы) ввести латинскую букву в сочетании с клавишей Shift или без нее, и нажать кнопку ОК см. рис 7.

Рис. 7 окно назначения управляющих клавиш макросу в Excel.

Примечание:
Через меню приложения Excel можно назначить сочетание клавиш только в комбинации с клавишей CTRL или CTRL+SHIFT, но программно в данном приложении можно ввести и другие комбинации управляющих клавиш.

Программное назначение управляющих клавиш макросам

В приложении Excel программно можно назначить клавиши макросу через метод OnKey объекта Application. Метод OnKey имеет два входных параметра Key – для назначение комбинаций клавиш, и Procedure – для ввода имени макроса, которому назначаются управляющие клавиши (перед именем макроса может быть имя одной из загруженных книг Excel в которой макрос находится см. пример ниже. Имя книги общих макросов – “PERSONAL.XLS”). Если параметр Procedure опущен, то указанная комбинация клавиш снимается с макроса, на который она была установлена. Если параметр Procedure имеет значение пустой строки, то указанная комбинация клавиш блокируется в Excel. Комбинация клавиш задается в строковом формате, клавиши в строке кодируются следующим образом:

Клавиша
 Тип клавиши
 Код клавиши
 
CTRL
 Управляющие
 ^
 
Alt
 %
 
Shift
 +
 
A
 Буквенные  {A}
 
B
 {B}
 
0
 Цифровые
 0
 
1
 1
 
F1
 Другие
 {F1}
 
Num Lock
 {NUMLOCK}
 
<
 Стрелки
 {LEFT}
 
>
 {RIGHT}
 
^
 {UP}
 
v
 {DOWN}

Application.onkey “%1”,”Пункт1”
Application.onkey “^+{A}”,”’Моя книга.xls’!ПунктА”
Application.onkey “^+{B}”

В данном примере назначаются управляющие клавиши Alt+1 макросу Пункт1, и клавиши Ctrl+Shift+A макросу ПунктA находящемуся в Excel файле с именем “Моя книга”. И снимается зарезервированная комбинация управляющих клавиш CTRL+Shift+B с макроса проекта.
В приложении Word управляющие клавиши макросу назначаются через метод Add объекта KeyBindings, и удаляются через метод Disable объекта FindKey. В методе Add объекта KeyBindings имеется входной параметр KeyCode, который определяет комбинацию управляющих клавиш, и входной параметр Command, который задает имя макроса. Функция BuildKeyCode предназначена для задания кода управляющих клавиш входному параметру KeyCode. Функция BuildKeyCode может иметь от одного, до 4 входных аргументов, которые задаются соответствующими константами:

Клавиша
 Тип клавиши
 Имя константы
 
CTRL
 Управляющие
 WdKeyControl
 
Alt
 WdKeyAlt
 
Shift
 wdKeyShift
 
A
 Буквенные WdKeyA
 
B
 WdKeyB
 
0
 Цифровые
 WdKey0
 
1
 WdKey1
 
F1
 Другие
 wdKeyF1
 
End
 wdKeyEND

‘Начинаем работать с управляющими клавишами общих макросов документов
CustomizationContext = NormalTemplate
‘управляющие клавиши Alt+M назначаются макросу с именем "Мой"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyAlt, wdKeyM), _
        KeyCategory:=wdKeyCategoryMacro, Command:="Мой"
‘Начинаем работать с управляющими клавишами активного документа
CustomizationContext = ActiveDocument
‘удаляем, ранее зарезервированные клавиши Ctrl+Alt+D
    FindKey(BuildKeyCode(wdKeyControl, wdKeyAlt, wdKeyD)).Disable

Примечение радактора

Скрепя сердце я публиковал эту статью, глядя на "русские" имена переменных и имен функций. Сама статья достаточно подробна и проста для понимания даже начинающим, но именно за них я и боюсь. Настоятельно рекомендую использовать только символы [0-9], _ и [A-Z], [a-z] в именах переменных. Даже в случае приложений написанных на Visual Basic for Applications, где поддерживаются подобные имена.