www.ПЕРВЫЕ ШАГИ.ru :: Шаг 69 - Динамическое создание меню

VBA

Шаг 69 - Динамическое создание меню

Смотрим код:

Const menuname = "Геохимия"

Private Sub Workbook_AddinInstall()
	' обработка ошибки
	On Error GoTo errors:
	 Dim num As Integer
	' получаем количество пунктов меню
	 num = Application.CommandBars("Worksheet Menu Bar").Controls.Count
	' добавляем 1 для следующего
	num = num + 1
	Dim a As CommandBarControl
	' создаем новый пункт меню
	Set a = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, Before:=num)
	' даем имя
	a.Caption = menuname
	Dim help As CommandBarControl
	Set help = Application.CommandBars("Настраиваемое всплывающее меню1").Controls.Add(Type:=msoControlButton, Before:=1)
	help.Caption = "Помощь"
	help.OnAction = "Help"
	Dim comms As CommandBarControl
	Set comms = Application.CommandBars("Настраиваемое всплывающее меню1").Controls.Add(Type:=msoControlButton, Before:=2)
	comms.Caption = "Расчет аномальных значений нормальный закон"
	comms.OnAction = "Anomal"
	Dim commslog As CommandBarControl
	Set commslog = Application.CommandBars("Настраиваемое всплывающее меню1").Controls.Add(Type:=msoControlButton, Before:=3)
	commslog.Caption = "Расчет аномальных значений логнормальный закон"
	commslog.OnAction = "Anomallog"
	Dim commsbeg As CommandBarControl
	Set commsbeg = Application.CommandBars("Настраиваемое всплывающее меню1").Controls.Add(Type:=msoControlButton, Before:=4)
	commsbeg.Caption = "Пробежаться по значения"
	commsbeg.OnAction = "beg"
	Exit Sub
	' что будем делать при ошибке
errors:
	MsgBox Err.Description + " соoбщите разработчику"
	Err.Clear
End Sub

Основа кода коллекция CommandBars, которая отвечает коллекции меню. У этой коллекции есть метод Add, после которого меню надо присвоить название и имя макроса.

help.Caption = "Помощь"
help.OnAction = "Help"

Удаляется меню по имени. Вот код:

Private Sub Workbook_AddinUninstall()
	On Error GoTo errors:
	Application.CommandBars("Worksheet Menu Bar").Controls(menuname).Delete
	Exit Sub
	' что будем делать при ошибке
	MsgBox "не могу удалить пункт меню"
errors:
End Sub

Если Вы обратите внимание, то меню устанавливается при подключении расширения Excel, а удаляются при его отключении.


Предыдущий Шаг | Следующий Шаг
Автор Каев Артем.