Toolbar Menu problems

[Nigel]

I have set the following code up to create a new toolbar, it works until I
try to add the rsOp1 and rsOp2 popup items - what is wrong with this code?

Dim rsTB As CommandBar
Set rsTB = Application.CommandBars.Add(Name:="rsTB", Position:=msoBarTop,
MenuBar:=False)
rsTB.Visible = True
rsTB.Protection = msoBarNoChangeVisible + msoBarNoResize +
msoBarNoChangeDock

Dim rsBut As CommandBarPopup
Dim rsOp1 As CommandBarPopup, rsOp2 As CommandBarPopup

Set rsBut =
Application.CommandBars("rsTB").Controls.Add(Type:=msoControlPopup,
before:=1)
Set rsOp1 = Application.CommandBars("rsTB").Controls("rsBut").Controls.Add()
Set rsOp2 = Application.CommandBars("rsTB").Controls("rsBut").Controls.Add()

rsBut.Caption = "SAM Report"
rsOp1.Caption = "Summary"
rsOp2.Caption = "Targets"

 

[keepITcool]

Nigel:
set the protection AFTER you've added the controls.

also, I always create toolbars and controls with Temporary property set
to true, this avoids contaminating the user's .olb file.

Sub NigelTB()

Const TBNAME = "rsTB"
With Application.CommandBars
On Error Resume Next
.Item(TBNAME).Delete
On Error GoTo 0

'Commandbar
With .Add(TBNAME, Position:=msoBarTop, Temporary:=True)
'PopUp
With .Controls.Add(Type:=msoControlPopup, Temporary:=True)
.Caption = "SAM report"
'Buttons
With .Controls.Add(Parameter:=1, Temporary:=True)
.Caption = "Summary"
.OnAction = ThisWorkbook.Name & "!tbHandler"
End With
With .Controls.Add(Parameter:=2, Temporary:=True)
.Caption = "Targets"
.OnAction = ThisWorkbook.Name & "!tbHandler"
End With
End With
.Visible = True
.Protection = msoBarNoChangeVisible + _
msoBarNoResize + _
msoBarNoChangeDock + _
msoBarNoMove
End With
End With
End Sub

Sub tbHandler()
Select Case Application.CommandBars.ActionControl.Parameter
Case 1: MsgBox "Do Summary"
Case 2: MsgBox "Do Targets"
End Select
End Sub


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Nigel wrote :

 

[Nigel]

Hi keepItCool
That fixed it and gave me some insight how to handle parameters in the
actioncontrol. That is neat!

I have a supplementary questions...

Using this method I have added another control (dropdown box) and filled the
values from a worksheet list (that works), given it a parameter of 8. How
do I pass the value of the listindex from the control to the tbhandler or do
I need to use something else?

............
With .Controls.Add(Parameter:=8, Type:=msoControlDropdown,
Temporary:=True)
.Caption = "Region"

Dim ctl As Worksheet
Set ctl = Sheets("Control")
Dim LrowTlist As Integer, xi As Integer
LrowTlist = ctl.Cells(Rows.Count, "B").End(xlUp).Row
.Style = msoButtonAutomatic
.OnAction = ThisWorkbook.Name & "!tbhandler"
For xi = 3 To LrowTlist
.AddItem ctl.Cells(xi, 2).Value
Next xi
.ListIndex = 1
End With
.........

 

[keepITcool]

Sub tbHandler()

With Application.CommandBars.ActionControl
Select Case .Parameter
Case 1: MsgBox "Do Summary"
Case 2: MsgBox "Do Targets"
Case 8: MsgBox .ListIndex & .List(.ListIndex)
End Select
End With

End Sub

also: look at naming conventions for variables...
your original had toolbars named rs (recordset?)
below has a worksheet named ctl (control).
also: dim your variables at the top of the procedure.

note: the onaction parameter s/b set last,
AFTER adding the listitems.


Dim cel, rng
.......
With .Controls.Add(Parameter:=8, Temporary:=True, _
Type:=msoControlDropdown)
.Caption = "Region"
With Worksheets("Control")
Set rng = .Range(.Cells(3, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
For Each cel In rng
.AddItem cel.Value
Next
.ListIndex = 1
.OnAction = ThisWorkbook.Name & "!tbhandler"
End With



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Nigel wrote :

 

[Nigel]

That did the trick, Many thanks.