1

我正在使用此代码为我的数据表表单 (Access 2007) 创建一个右键菜单。此代码在 Open 事件的数据表子窗体中运行：

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 函数。如果我能弄清楚如何传递表单或记录集变量/引用，我会很高兴，但我似乎也不知道如何做到这一点。

将“实时”参数或参数从右键菜单传递到自定义函数的技巧是什么？用户点击的时候一定要建立右键菜单吗？或者有没有更好的方法来做到这一点？

Edit1：
这是我到目前为止所做的工作：

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
4

1 回答 1

0

怎么样：

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

测试时不要忘记关闭并重新打开表单:)

于 2012-05-22T07:49:14.883 回答