VBA Detail Shortcut Menu

Question

I am updating some old VBA code to work with Access 2010. One problem we encountered is that no Shortcut Menu appears when you right click so we create a shortcut menu and bound it to the Application object like so...

Application.ShortcutMenuBar = "GeneralClipboardMenu"

In general this works however if you right click on a column in a Detail pane, "Which we are using as an excel grid", no menu appears. This aspect is critical to the use of our application so we can not ignore it.

Nowhere in the code are Shortcut Menus being disable. Also I realize shortcut menus are being replaced by the ribbon in the 2010 Office suit however right click is a basic feature that we would ideally like to keep.

Any help would be greatly appreciated. Here is the code for creating the shortcut menu in-case it is relevant.

Sub CreateSimpleShortcutMenu()
  On Error Resume Next 'If menu with same name exists delete
  CommandBars("GeneralClipboardMenu").Delete
  Dim cmb As CommandBar
  Set cmb = CommandBars.Add("GeneralClipboardMenu", msoBarPopup, False, False)
      With cmb
          .Controls.Add msoControlButton, 21, , , True   ' Cut
          .Controls.Add msoControlButton, 19, , , True   ' Copy
          .Controls.Add msoControlButton, 22, , , True   ' Paste
          .Controls.Add msoControlButton, 4016, , , True 'Sort Ascending
          .Controls.Add msoControlButton, 4017, , , True 'Sort Decending
      End With
  Set cmb = Nothing
End Sub

HK1 HK1 · Accepted Answer · 2012-06-28T15:17:12

I believe the Application-wide Shortcut Menu bar is a DAO database property. You can change it in the GUI under Access Options > Current Database > Ribbon and Toolbar Options.

You can also change it using the following code:

UpdateCustomProperty("StartupShortcutMenuBar", "NameOfMyCustomShortcutMenuBar")

Private Function CreateCustomProperty(ByVal sPropertyName As String, _
                                        ByVal sPropertyValue As String)
    On Error Resume Next

    If sPropertyName <> "" And sPropertyValue <> "" Then
        Dim p1 As DAO.Property
        Set p1 = CurrentDb.CreateProperty(sPropertyName, DB_TEXT, sPropertyValue)
        CurrentDb.Properties.Append p1
        Set p1 = Nothing
    End If

End Function

Public Function UpdateCustomProperty(ByVal sPropertyName As String, _
                                    ByVal sPropertyValue As String)
    On Error Resume Next

    If sPropertyName <> "" And sPropertyValue <> "" Then
        CurrentDb.Properties(sPropertyName) = sPropertyValue
        If Err.Number = 3270 Then
            Err.Clear
            Call CreateCustomProperty(sPropertyName, sPropertyValue)
        End If
    End If
    Err.Clear
End Function

VBA Detail Shortcut Menu

3 Answers