自定义右键菜单 - OnAction 立即生效，而不是按下按钮

Question

我正在 Excel 中创建一个自定义菜单，其中包含各种子菜单。它用于挑选各种机械物品，大约有 250 种可能的结果。

无论如何，我已经构建了菜单并希望它能够在使用菜单时将 .Caption 输入到单元格中。我已将 .OnAction 放入相关按钮中，但不幸的是，.OnAction 在打开文件时激活，而不是在单击按钮时激活。因此，所有 250 多个 .Captions 都会快速连续地输入到同一单元格中。

快速编辑 - 重要的部分位于 BuildMenus 的底部，其中 .OnAction 调用函数 AddStuff。我知道这是在 Workbook_Activate 上运行的，这就是为什么它会立即运行，但我在网上查看的其他地方都是以同样的方式运行的。

Private Sub Workbook_Activate()
BuildMenus
End Sub

Private Sub BuildMenus()
'Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim AmountOfCats As Integer
Dim ThisIsMyCell As String
ThisIsMyCell = ActiveCell.Address
'this is where we would set the amount of categories. At the moment we'll have it as 15
AmountOfCats = 15
Dim cBut As CommandBarControl
Dim Cats As CommandBarControl
Dim SubCats As CommandBarControl
Dim MenuDesc As CommandBarButton
On Error Resume Next
With Application
    .CommandBars("Cell").Controls("Pick Machinery/Plant...").Delete
End With
Set cBut = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Temporary:=True)
cBut.Caption = "Pick Machinery/Plant.."
With cBut
    .Caption = "Pick Machinery/Plant..."
    .Style = msoButtonCaption
End With
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim SC As Integer
Dim AmountOfMenus As Integer
SC = 1
Dim MD As Integer
MD = 1
Dim MyCaption As String
For i = 0 To AmountOfCats - 1
    Set Cats = cBut.Controls.Add(Type:=msoControlPopup, Temporary:=True)
    Cats.Caption = Categories(i + 1)
    Cats.Tag = i + 1
    For j = 0 To (SubCatAmounts(i + 1) - 1)
        Set SubCats = Cats.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        SubCats.Caption = SubCatArray(SC)
        SubCats.Tag = j + 1
        AmountOfMenus = MenuAmounts(SC)
        For k = 0 To AmountOfMenus - 1
            Set MenuDesc = SubCats.Controls.Add(Type:=msoControlButton)
            With MenuDesc
                .Caption = MenuArray(MD)
                .Tag = MD
                MyCaption = .Caption
                .OnAction = AddStuff(MyCaption)
            End With
            MD = MD + 1
        Next
        SC = SC + 1
    Next
Next
On Error GoTo 0
End Sub

Function AddStuff(Stuff As String)
Dim MyCell As String
MyCell = ActiveCell.Address
ActiveCell.Value = Stuff
End Function

Answer 1

OnAction 需要一个字符串值：相反，您在创建菜单时调用您的 AddStuff 子程序...

.OnAction = "AddStuff """ & MyCaption & """"

就是您想要的（假设我的引号正确）

Answer 2

我在使用 AddStuff 时犯了一个错误 - 我将其作为函数调用，而实际上它应该是一个宏（或常规子函数）。对 Tim Williams 的 .OnAction 代码进行轻微修改

MyButton.OnAction = "AddStuff(""" & MyButton.Caption & """)"

即可达到目的。