Custom right-click menu - OnAction works straight away rather than on button-press
I'm creating a custom menu in Excel which consists of various sub-menus. It's for picking various machinery items and there's about 250 possible outcomes.
In any case, I've got the menu built and want it so that the .Caption is entered into the cell when the menu is used. I've put the .OnAction into the relevant buttons but, unfortunately, the .OnAction activates when the 开发者_Go百科file is opened, not when the button is clicked. As such, all 250-odd .Captions are quickly entered into the same cell in quick succession.
Quick edit - the important bit is towards the bottom of the BuildMenus, where the .OnAction calls the function AddStuff. I know this is running on the Workbook_Activate which is why it runs straight away but everywhere else I've looked online does it the same way.
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
OnAction expects a string value: instead you are calling your AddStuff sub while creating your menu...
.OnAction = "AddStuff """ & MyCaption & """"
is what you want (assuming I got my quotes right)
I was making a mistake with my AddStuff
- I was calling it as a function when instead it should have been a macro (or a regular sub). A slight modification to Tim Williams' .OnAction
code
MyButton.OnAction = "AddStuff(""" & MyButton.Caption & """)"
did the trick.
精彩评论