我使用此代码为我的数据表表格( Access 2007) 创建右键点击菜单 (2007年) 。 此代码在“ 开放事件” 上的数据表子格式中运行 :
Dim sMenuName As String
sMenuName = "DatasheetRightClickMenu"
On Error Resume Next
CommandBars(sMenuName).Delete
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
Dim cmb As Office.CommandBar
Dim cmbItem
Set cmb = CommandBars.Add(sMenuName, _
msoBarPopup, False, False)
Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
.Caption = "Open"
.OnAction = "=OpenDetails()"
End With
Me.ShortcutMenu = True
Me.ShortcutMenuBar = sMenuName
我无法找到如何将当前记录 S ID 传送到 OpenDetails 函数。 如果我能找到如何以表格或记录变量/参考格式通过, 我会很高兴的, 但我似乎无法找到如何做到这一点。
将“ 实时” 参数或参数从右键单击菜单转到自定义函数的技巧是什么? 当用户单击时, 您是否必须构建右键单击菜单? 或者是否有更好的方法这样做?
Edit1:
Here s what I have got working so far:
Private Sub Form_Current()
Call CreateRightClickMenu
End Sub
Private Sub CreateRightClickMenu()
Dim sMenuName As String
sMenuName = Me.Name & "RClickMenu"
On Error Resume Next
CommandBars(sMenuName).Delete
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
Dim cmb As Office.CommandBar
Dim cmbItem
Set cmb = CommandBars.Add(sMenuName, _
msoBarPopup, False, False)
Dim s1() As String, s2 As String
If Nz(Me.txtitemdesc, "") <> "" Then
s2 = Me.txtitemdesc & " "
s2 = Replace(s2, ",", " ")
s1 = Split(s2, " ")
s2 = s1(0)
End If
Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
.Caption = "Open " & Replace(Me.txtitemdesc, "&", "&&")
.Parameter = Me!ItemID
.OnAction = "OpenFromDatasheetRightClick"
End With
Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
.FaceId = 640
.Caption = "Filter = " & s2 & " "
.Parameter = s2
.OnAction = "FilterAllItemsDatasheet"
End With
If Me.FilterOn = True And Me.Filter <> "" Then
Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
.Caption = "Clear Filter"
.Parameter = ""
.OnAction = "FilterAllItemsDatasheet"
End With
End If
Me.ShortcutMenu = True
Me.ShortcutMenuBar = sMenuName
End Sub
看来我的回馈功能 必须是在一个公共模块, 而不是一个形式模块。
Public Sub FilterAllItemsDatasheet()
Dim cbar As CommandBarControl
Set cbar = CommandBars.ActionControl
If cbar Is Nothing Then
Debug.Print "CBar is nothing"
Exit Sub
End If
Dim s1
s1 = cbar.Parameter
If s1 = "" Then
Call Forms("frmAllItemsDatasheet").ClearFilter
Else
Forms("frmAllItemsDatasheet").cboSearch = s1
Call Forms("frmAllItemsDatasheet").UpdateSubform
End If
End Sub
Public Sub OpenFromDatasheetRightClick()
Dim cbar As CommandBarControl
Set cbar = CommandBars.ActionControl
If cbar Is Nothing Then
Debug.Print "CBar is nothing"
Exit Sub
End If
Dim s1
s1 = cbar.Parameter
Call OpenItemDetailForm(s1)
Forms("frmAllItemsDatasheet").SetFocus
End Sub