OnAction of Menu Bar with variable parameters

[chris]

I'm trying to create a menubar which will set the onaction property of
each item to the same function. The only difference between each
button will be the variable it passes into it (which needs to be which
worksheet to use). Here is my code below so you can see what I'm
trying to do. The line with the "*" is the one which has the compile
error. I know it's wrong but I'm not sure how to change it to work.

Sub CreateMenubar()
Dim iCtr As Integer
iCtr = 0
Dim CapNames As Variant
Dim MenuObject As CommandBarPopup
Dim ws As Worksheet


Call RemoveMenubar


CapNames = Array()
ReDim CapNames(Sheets.Count - 1)
For Each ws In Worksheets
CapNames(ws.Index - 1) = ws.Name
Next


Set MenuObject =
Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, _
Before:=11, Temporary:=True)
MenuObject.Caption = MenuBarName


For iCtr = LBound(CapNames) To UBound(CapNames)
With MenuObject.Controls.Add(Type:=msoControlButton)
*.OnAction = "'" & ThisWorkbook.Name & "'!" &
"DecisionTree(" & Sheets(CapNames(iCtr)) & ")"
.Caption = CapNames(iCtr)
End With
Next iCtr
End Sub


Sub DecisionTree(ws As Worksheet)


Application.ScreenUpdating = False


MsgBox ("Welcome to the " & StrConv(ws.Name, vbProperCase) & "
decision tree.")
Cells(ws.Columns(1).Find(What:="A", LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Row, 2).Select
ws.Cells(2, 2).Select


Do While ActiveCell.Offset(0, 3) = ""
If MsgBox(ActiveCell.Value, vbYesNo) = vbYes Then
Cells(FindIt(1, ws), 2).Select
Else
Cells(FindIt(2, ws), 2).Select
End If
Loop


MsgBox (ActiveCell.Value)
Application.ScreenUpdating = True
End Sub


Any help is much appreciated. Thanks!

 

[Bob Phillips]

Set the Parameter property of the commandbar control to the worksheet name,
and trap that in the procedure

.OnAction = "DecisionTree"
.Parameter = Sheets(CapNames(iCtr))


Sub DecisionTree()

Select Case Application.Commandbars.ActionControl.Parameter
Case "Sheet1": 'do something
Case "Sheet2": 'do something else
End Select

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)