Rename and use toolbar menu name by user entry

[Guest]

Ok this my be hard to discribe but here goes.

I would like to create a customised menu toolbar with a menu drop down list.
I would like a menu under this drop down list to show a 6 digit number as
it's name. When the user clicks on this number a macro is run that asks the
user for a new 6 digit number and displays this as the new menu name. I would
like this new 6 digit name to be store in a public variable for other macros
to use.

I would like this menu button in a toolbar menu not in a excel file cell
drop down list.

Is this possible?

Thanks

 

[Dave Peterson]

This may get you started.

It actually doesn't store the number in a public variable--I figured it would be
just as easy to read what the dropdown showed and use that.

'This stuff builds the toolbar and handles changes

Option Explicit
Public Const myToolBarName As String = "myNumbers"
Sub auto_close()
On Error Resume Next
Application.CommandBars(myToolBarName).Delete
On Error GoTo 0
End Sub
Sub auto_open()

Dim cb As CommandBar
Dim Ctrl As CommandBarControl
Dim wks As Worksheet

On Error Resume Next
Application.CommandBars(myToolBarName).Delete
On Error GoTo 0

Set cb = Application.CommandBars.Add(Name:="myNumbers", temporary:=True)
With cb
.Position = msoBarTop
.Visible = True
Set Ctrl = .Controls.Add(Type:=msoControlComboBox, temporary:=True)
With Ctrl
.Width = 75
.OnAction = "'" & ThisWorkbook.Name & "'!changetheNumber"
End With
End With

End Sub
Sub ChangeTheNumber()

Dim myNumber As Long
Dim ErrFound As Boolean
Dim MatchFound As Boolean
Dim iCtr As Long

With Application.CommandBars.ActionControl
If .ListIndex = 0 Then
ErrFound = False
If IsNumeric(.Text) Then
myNumber = CLng(.Text)
If myNumber < 100000 _
And myNumber > 0 Then
ErrFound = False
'check for existing value
MatchFound = False
For iCtr = 1 To .ListCount
If myNumber = CLng(.List(iCtr)) Then
'found a match
MatchFound = True
.Text = .List(iCtr)
Exit For
End If
Next iCtr
End If
End If
If MatchFound Then
'do nothing
Else
If ErrFound = False Then
.AddItem Format(myNumber, "000000")
.Text = Format(myNumber, "000000")
Else
.Text = ""
Beep
End If
End If
End If
End With

End Sub


'and to show how to pick up that displayed number.

Sub testme()

Dim cb As CommandBar
Dim myNumber As Long

Set cb = Nothing
On Error Resume Next
Set cb = Application.CommandBars(myToolBarName)
On Error GoTo 0

If cb Is Nothing Then
MsgBox "the commandbar is gone!"
Exit Sub
End If

If IsNumeric(cb.Controls(1).Text) = False Then
MsgBox "nothing chosen"
myNumber = 0
Else
myNumber = CLng(cb.Controls(1).Text)
End If

MsgBox myNumber

End Sub

 

[Dave Peterson]

And change this line:

Set cb = Application.CommandBars.Add(Name:="myNumbers", temporary:=True)
to
Set cb = Application.CommandBars.Add(Name:=myToolBarName, temporary:=True)

I wanted to make sure you only had to change the name of the toolbar in one
spot--and I missed one.

 

[Guest]

Thanks Dave, managed to figure it out

And change this line:

Set cb = Application.CommandBars.Add(Name:="myNumbers", temporary:=True)
to
Set cb = Application.CommandBars.Add(Name:=myToolBarName, temporary:=True)

I wanted to make sure you only had to change the name of the toolbar in one
spot--and I missed one.