The goal is to create menus which can be utilized with certain controls on an MS Access form and to be able to right click on a that control, for example on a listbox and a relevant context specific menu popup with options, which if clicked, would trigger a predefined subroutine or function.
What is the best method to accomplish this programmatically?
I am using MS Access 2003 and would like to do this using VBA.
Type regedit and press Enter. You should see a value named MenuDropAlignment in the right pane (If it doesn't exist, create a new string value named MenuDropAlignment). Double-click on it to modify. In order to make context menu open to the right side, type 0 in the Value data field and click OK.
To make this HTML menu visible when right-clicking in the browser, we need to listen for contextmenu events. We can bind the event listener directly on the document or we can limit the area that a user can right-click to see the custom context menu. In our example, the area for right-click is the entire body element.
First create an _MouseUp
event to execute on the respective control looking to see if the right mouse button was clicked and if so, call the .ShowPopup
method.
Of course this assumes the
Private Sub MyListControlName_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Long, ByVal Y As Long)
' Call the SetUpContextMenu function to ensure it is setup with most current context
' Note: This really only needs to be setup once for this example since nothing is
' changed contextually here, but it could be further expanded to accomplish this
SetUpContextMenu
' See if the right mouse button was clicked
If Button = acRightButton Then
CommandBars("MyListControlContextMenu").ShowPopup
End If
End Sub
Since at this point the Command Bar MyListControlContextMenu
is undefined, I define the Menu in a separate module as follows:
Public Sub SetUpContextMenu()
' Note: This requires a reference to Microsoft Office Object Library
Dim combo As CommandBarComboBox
' Since it may have been defined in the past, it should be deleted,
' or if it has not been defined in the past, the error should be ignored
On Error Resume Next
CommandBars("MyListControlContextMenu").Delete
On Error GoTo 0
' Make this menu a popup menu
With CommandBars.Add(Name:="MyListControlContextMenu", Position:=msoBarPopup)
' Provide the user the ability to input text using the msoControlEdit type
Set combo = .Controls.Add(Type:=msoControlEdit)
combo.Caption = "Lookup Text:" ' Add a label the user will see
combo.OnAction = "getText" ' Add the name of a function to call
' Provide the user the ability to click a menu option to execute a function
Set combo = .Controls.Add(Type:=msoControlButton)
combo.BeginGroup = True ' Add a line to separate above group
combo.Caption = "Lookup Details" ' Add label the user will see
combo.OnAction = "LookupDetailsFunction" ' Add the name of a function to call
' Provide the user the ability to click a menu option to execute a function
Set combo = .Controls.Add(Type:=msoControlButton)
combo.Caption = "Delete Record" ' Add a label the user will see
combo.OnAction = "DeleteRecordFunction" ' Add the name of the function to call
End With
End Sub
Since three function have been referenced, we can move on to define these as follows-
getText: Note, this option requires a reference to both the name of the Command Bar menu name as well as the name of the control caption.
Public Function getText() As String
getText = CommandBars("MyListControlContextMenu").Controls("Lookup Text:").Text
' You could optionally do something with this text here,
' such as pass it into another function ...
MsgBox "You typed the following text into the menu: " & getText
End Function
LookupDetailsFunction: For this example, I will create a shell function and return the text "Hello World!".
Public Function LookupDetailsFunction() As String
LookupDetailsFunction = "Hello World!"
MsgBox LookupDetailsFunction, vbInformation, "Notice!"
End Function
DeleteRecordFunction: For this example, I will ensure the control is still valid by checking it against null, and if still valid, will execute a query to remove the record from a table.
Public Function DeleteRecordFunction() As String
If Not IsNull(Forms!MyFormName.Controls("MyListControlName").Column(0)) Then
Currentdb.Execute _
"DELETE * FROM [MyTableName] " & _
"WHERE MyKey = " & Forms!MyFormName.Controls("MyListControlName").Column(0) & ";"
MsgBox "Record Deleted", vbInformation, "Notice!"
End If
End Function
Note: For LookupDetailsFunction
, DeleteRecordFunction
and getText
functions, these must be within a public scope to work correctly.
Finally, the last step is to test the menu. To do this, open the form, right click on the list control and select one of the options from the popup menu.
Optionally button.FaceID
can be utilized to indicate a known office icon to associate with each instance of the menu popup control.
I found Pillai Shyam's work on creating a FaceID Browser Add-In to be very helpful.
References: Microsoft FaceID
Try This
Sub Add2Menu()
Set newItem = CommandBars("Form View Popup").Controls.Add(Type:=1)
With newItem
.BeginGroup = True
.Caption = "Make Report"
.FaceID = 0
.OnAction = "qtrReport"
End With
End Sub
As you can see it will add item in "Form View Popup" Command Bar and when this item is clicked it will load procedure qtrReport
And use this function to see all Commandbars in Access
Sub ListAllCommandBars()
For i = 1 To Application.CommandBars.Count
Debug.Print Application.CommandBars(i).Name
Next
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With