自定义右键单击菜单 - OnAction可以直接使用,而不是按下按钮

时间:2011-09-23 10:59:17

标签: excel vba menu right-click

我正在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

2 个答案:

答案 0 :(得分:2)

OnAction需要一个字符串值:而不是在创建菜单时调用你的AddStuff子...

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

是你想要的(假设我的报价是正确的)

答案 1 :(得分:0)

我的AddStuff犯了一个错误 - 我把它当作一个函数来代替它应该是一个宏(或一个普通的子)。对Tim Williams'.OnAction代码

的略微修改
MyButton.OnAction = "AddStuff(""" & MyButton.Caption & """)"

做了这个伎俩。