从右键单击CommandBar菜单打开当前记录 [英] Open Current Record from Right-Click CommandBar Menu
问题描述
我正在使用此代码为我的数据表表单(Access 2007)创建一个右键单击菜单.这段代码在Open事件的数据表子窗体中运行:
I'm using this code to create a right-click menu for my Datasheet form (Access 2007). This code runs in the datasheet subform on the Open event:
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
我不知道如何将当前记录的ID传递给OpenDetails函数.如果我能弄清楚如何传递表格或记录集变量/引用,我会很高兴,但我似乎也无法弄清楚该怎么做.
I can't figure out how to pass the current record's ID to the OpenDetails function. I'd be happy if I could just figure out how to pass in the form or recordset variable/reference but I can't seem to figure out how to do that either.
将实时"参数或参数从右键菜单传递到自定义函数的窍门是什么?用户单击时是否必须构建右键菜单?还是有更好的方法呢?
What's the trick to passing "real-time" arguments or parameters from a right-click menu to a custom function? Do you have to build the right-click menu when the user clicks? Or is there a better way of doing this?
到目前为止,这是我的工作:
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
似乎我的回调函数必须在公共模块中,而不是在表单模块中.
It seems that my callback functions have to be in a a public module, not a form module.
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
推荐答案
怎么样:
Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
.Caption = "Open"
.OnAction = "=OpenDetails([ID])"
End With
''Function
Function OpenDetails(intID)
MsgBox intID
''This would also work
MsgBox Screen.ActiveForm.ID
End Function
在测试时,别忘了关闭并重新打开表单:)
Don't forget to close and reopen the form when testing :)
这篇关于从右键单击CommandBar菜单打开当前记录的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!