Я делаю в Access и в VB6.0,
Shocker.Pro
у Shamanus пример для VBA
Мой пример для VB
вы вообще в чем пишете?
Если вставить этот код в Access, то ничего непроисходит, просто открывается форма и все
Hugo121Я проверил, работает. Там из кода надо убрать [B], и модуль я делал в форме. Вобщем, вот дополненная мной инструкция:
+
Popup на форме
Класс создавать не надо. Microsoft его уже создал
Вот один из вариантов: (проверено в Excel 2000/2003)
В код формы пишем следующее:
Код :
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then СозданиеМеню_ЗаполнениеЭтогоМенюЭлементами_и_ЕгоОтображение
End Sub
Создаём модуль формы, и вставляем в него такой код:
Код :
Sub СозданиеМеню_ЗаполнениеЭтогоМенюЭлементами_и_ЕгоОтображение()
On Error Resume Next: Application.CommandBars.Add "Моё контекстное меню", msoBarPopup
Dim p As CommandBar: Set p = Application.CommandBars("Моё контекстное меню")
'p.Reset - почему-то не работает ' очистка меню от прежних пунктов (если каждый раз добавляем разные пункты)
For Each ctrl In p.Controls: ctrl.Delete: Next ' а вот так пункты меню удаляются
AddItemIntoPopup p, 1, 161, "Make_Netflow_Report", "Обработка результатов запроса"
AddItemIntoPopup p, 4, -1, "SearchNumber", "Поиск номеров"
Set NewMenu = p.Controls.Add(Type:=msoControlPopup) ' подменю Additional Tools
With NewMenu: .Caption = "&Additional Tools": .BeginGroup = True: End With
AddItemIntoPopup NewMenu, 1, IIf(DemoMode, 232, 231), "ToggleDemoMode", IIf(DemoMode, "В&ыключить безопасный режим", "&Включить безопасный режим"), True, "Demo3"
AddItemIntoPopup NewMenu, 1, 3, "Save_AddIn_Copy_in_Settings", "Сохранить копию программы в папке Settings", True
AddItemIntoPopup NewMenu, 1, 749, "Save_AddIn_Copy", "Сохранить копию программы с указанием даты и времени"
AddItemIntoPopup NewMenu, 1, 2936, "PrepareAddInForUpdate", "Создать файл обновления", False
AddItemIntoPopup NewMenu, 1, 964, "Write_MainSettingsFile", "Перезаписать файл Main.ini", True
AddItemIntoPopup NewMenu, 1, 161, "MakeSummaryPage", "Создание сводной таблицы", False
AddItemIntoPopup NewMenu, 1, 3, "WriteDefaultRegistryValuesOnFirstRun", "Применить настройки по умолчанию", True
AddItemIntoPopup p, 1, 1088, "SetIsAddinTrue", "Скрыть листы файла программы", True
AddItemIntoPopup p, 1, 1087, "SetIsAddinFalse", "Отобразить листы файла программы", False
AddItemIntoPopup p, 1, 1809, "Install_Update_Local", "Install_Update_Local", True
p.ShowPopup
End Sub
Function AddItemIntoPopup(ByRef Comm_Bar, ByVal B_Type As Integer, ByVal B_Face As Integer, _
ByVal On_Action As String, ByVal B_Caption As String, Optional ByVal Begin_Group As Boolean = False, Optional Tag As String = "") As CommandBarControl
' добавляет контролы в меню Comm_Bar ' type=1 - это кнопка, type=4 - это комбобокс, 10 - popup
On Error Resume Next
Set Add_Control = Comm_Bar.Controls.Add(Type:=B_Type)
With Add_Control
If B_Face > 0 Then .FaceId = B_Face:
.Tag = Tag: .OnAction = On_Action: .Caption = B_Caption: If Begin_Group Then .BeginGroup = True
'If надо_сделать_пункт_недоступным Then .Enabled = False
End With
End Function
Потом запускаем форму,
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
и щелкаем на ней правой кнопкой мыши.
