Коды пиктограмм пункта меню
Для того, что бы узнать коды пиктограмм пунктов меню, необходимо создать приведенные ниже процедуры. И запустить процедуру FaceIdPicture. Для продолжения вывода пиктограмм необходимо нажать клавишу Enter, для завершения – необходимо выбрать пункт в контекстном меню “Выход”:
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
В данном примере заблокировано стандартное контекстное меню до второго столбца и четвертой строки листа Excel включительно.
Для создание контекстного меню необходимо в модуле макросов проекта создать функцию:
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
В данном примере создается на листе Excel контекстное меню с переключающимся пунктом.
Функцию СоздатьКонтекстноеМеню можно запускать и как процедуру, например, для продолжения подпунктов второго уровня, непосредственно из событийных процедур пунктов меню второго уровня(в приложении Word данную функцию нужно запускать из подпунктов меню третьего уровня).
Пример:
‘событийная процедура внутри модуля листа
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
В данном примере после нажатия правой клавишей мыши на соответствующем листе и после выбора соответствующих пунктов меню, контекстное меню примет вид:
рис 24 Контекстное меню пользователя