If you mean a shortcut menu, that you can use in the right click event of a
form, or in the click event of another control, here is how I do it. I have
a code module titled (mod_Menus) which contains all of the code for my
shortcut menus. I've found this much more transportable than the menus I
used to create in 2000 with the Tools, Customize dialog.
The code below is my standard shortcut menu for textboxes. You can either
set the textboxes shortcut menu property to "MyTextMenu" or, sometimes, when
I want to "prevent" shortcut menus on my forms, I'll use the controls mouse
down event and check to see if the button pressed was the right button. If
so, then I use code similar to the following to activate the shortcut menu
commandbars("myTextMenu").showpopup
HTH
Dale
Code follows:
Const BarPopup = 5
Const ControlButton = 1
Const ControlEdit = 2
Const ControlComboBox = 4
Const ButtonUp = 0
Const ButtonDown = -1
'---------------------------------------------
Public Sub DeleteCmdBar(BarName As String)
Dim intLoop As Integer
'If an error is generated, it is because the command bar doesn't exist,
ignore it
On Error GoTo DeleteCmdBar_Error
CommandBars(BarName).Delete
Exit Sub
DeleteCmdBar_Error:
Err.Clear
End Sub
'--------------------------------
Public Sub TextMenu()
Dim cbr As Object
Dim cbrButton As Object
DeleteCmdBar ("MyTextMenu")
On Error GoTo TextMenuError
DoCmd.Hourglass True
Set cbr = CommandBars.Add("MyTextMenu", BarPopup, , True)
With cbr
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Copy"
.Tag = "Copy"
.OnAction = "=fnTextCopy()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Paste"
.Tag = "Paste"
.OnAction = "=fnTextPaste()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.begingroup = True
.Caption = "&Spell check"
.Tag = "Spell check"
.OnAction = "=fnTextSpell()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.begingroup = True
.Caption = "&Find"
.Tag = "Find"
.OnAction = "=fnTextFind()"
End With
End With
DoCmd.Hourglass False
Exit Sub
TextMenuError:
MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly,
"TextMenu error:"
End Sub
'--------------------------------------
Public Function fnTextCopy()
Dim frm As Form
Dim ctrl As Control
DoCmd.RunCommand acCmdCopy
End Function
'-----------------------
Public Function fnTextPaste()
On Error GoTo TextPasteError
DoCmd.RunCommand acCmdPaste
Exit Function
TextPasteError:
DisplayError ("Error while attempting to paste text!")
End Function
'-------------------------
Public Function fnTextSpell()
Dim frm As Form
Dim ctrl As TextBox
Set frm = Screen.ActiveForm
While frm.ActiveControl.ControlType = acSubform
Set frm = frm.ActiveControl.Form
Wend
Set ctrl = frm.ActiveControl
With ctrl
If ctrl.SelLength = 0 Then
ctrl.SelStart = 0
ctrl.SelLength = Len(ctrl.Text)
End If
End With
DoCmd.RunCommand acCmdSpelling
End Function
