Sağ tık ile açılan menü var. Bu menu treeview benzeri açılan alt menüler şeklinde olabilir mi
sağ tıkladığımda açılan menüde çıkan iteme tıkladığımda bir subitem
ona da tıkladığımda subsubitem olsa
excel için hazırlanmış bir kod buldum bunu Access için yapmaya çalıştım yapamadım
modül içerisine
Kod:
Option Explicit
Public ButtonEvent As clsBtn
Public ButtonEvents As Collection
Const SUBMENUNAME As String = "Company Listings"
Sub Create_RC_Menu()
Dim Cell As CommandBar
Dim SubMenu As CommandBarPopup
Dim SubItem As CommandBarButton
Call Delete_RC_Menu
Set Cell = Application.CommandBars("Cell")
Set SubMenu = Cell.Controls.Add(Type:=msoControlPopup, before:=1)
SubMenu.Caption = SUBMENUNAME
Set ButtonEvents = New Collection
'### Add additional as needed..
Set SubItem = SubMenu.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "&First"
Set ButtonEvent = New clsBtn
Set ButtonEvent.Btn = SubItem
ButtonEvents.Add ButtonEvent
'###
Set SubItem = SubMenu.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "&Second"
Set ButtonEvent = New clsBtn
Set ButtonEvent.Btn = SubItem
ButtonEvents.Add ButtonEvent
'###
Set SubItem = SubMenu.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "&Third"
Set ButtonEvent = New clsBtn
Set ButtonEvent.Btn = SubItem
ButtonEvents.Add ButtonEvent
'###
Set SubItem = SubMenu.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "&Custom Listing..."
SubItem.BeginGroup = True
Set ButtonEvent = New clsBtn
Set ButtonEvent.Btn = SubItem
ButtonEvents.Add ButtonEvent
'###
End Sub
Sub Delete_RC_Menu()
On Error Resume Next
Application.CommandBars("Cell").Controls(SUBMENUNAME).Delete
End SubKod:
Option Explicit
Public WithEvents Btn As CommandBarButton
Private Sub Btn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim strCustom As String, msgConfirm As VbMsgBoxResult
If ActiveCell.Value <> "" Then
msgConfirm = MsgBox("There is already a value in " & ActiveCell.Address & ". Continue?", vbYesNo, "OVERWRITE?")
If msgConfirm <> vbYes Then Exit Sub
End If
Select Case Ctrl.Caption
Case "First"
ActiveCell.Value = Ctrl.Caption
Case "Second"
ActiveCell.Value = Ctrl.Caption
Case "Third"
ActiveCell.Value = Ctrl.Caption
Case "Custom Listing..."
strCustom = InputBox("Enter Custom Company Listing:", "Custom Listing", "Custom Listing")
If strCustom <> "" Then ActiveCell.Value = strCustom
Case Else
MsgBox "There was no routine found!", vbCritical, "BUTTON ERROR!"
End Select
End SubKod:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Delete_RC_Menu
End Sub
Private Sub Workbook_Open()
Call Create_RC_Menu
End Sub
