ms-access - VBA 详细信息快捷菜单

Question

我正在更新一些旧的 VBA 代码以使用 Access 2010。我们遇到的一个问题是，右键单击时不会出现快捷菜单，因此我们创建一个快捷菜单并将其绑定(bind)到应用程序对象，如下所示...

Application.ShortcutMenuBar = "GeneralClipboardMenu"

一般来说，这是有效的，但是如果您右键单击详细信息 Pane 中的一列“我们将其用作 Excel 网格”，则不会出现菜单。这方面对于我们应用程序的使用至关重要，因此我们不能忽视它。

代码中没有任何地方禁用快捷菜单。我还意识到快捷菜单正在被 2010 Office 套装中的功能区取代，但右键单击是我们希望保留的基本功能。

任何帮助将不胜感激。这是创建快捷菜单的代码(如果相关的话)。

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

Answer 1

我相信应用程序范围的快捷菜单栏是 DAO 数据库属性。您可以在 GUI 中的“Access 选项”>“当前数据库”>“功能区和工具栏选项”下更改它。

您还可以使用以下代码更改它:

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