hi there!!!
I have a problem and i cant solve it.
I have the following code that is creating a menu.
I want when the submenu appears ("Choose Draws" in this occasion) and select it, to appears an textbox that it will read a value from the cell B1.
Then, when the user inserts a value, must be validated through a specific list which it will be, for example, in a range of cells A1:A10 with numbers 10 to 20. At last if the value is accepted will be copied to cell B1.
If the user press Esc, or leave the box empty then the value will be the same as before.
Thanks
-------------------------------------------------------------------------------
Option Explicit
Dim cbMenu As CommandBarControl
Dim cbSubMenu As CommandBarControl
Public MenuSeries
Public DrawsChoice As CommandBarComboBox
Sub CreateMenu()
' creates a new menu.
' can also be used to create commandbarbuttons
' may be automatically executed from an Aut
pen macro or a Workbook_Open eventmacro
RemoveMenu ' delete the menu if it already exists
' create a new menu on an existing commandbar (the next 6 lines)
Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = "&Joker"
.Tag = "JokerTag"
.BeginGroup = False
End With
' or add to an existing menu (use the next line instead of the previous 6 lines)
'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Tools-menu
If cbMenu Is Nothing Then Exit Sub ' didn't find the menu...
' add a submenu to the submenu
Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = "&Choose Draws"
.Tag = "SubMenu2"
End With
'---
Set DrawsChoice = cbSubMenu.Controls.Add(msoControlEdit)
With DrawsChoice
.Caption = "::"
.OnAction = "Draws_Selection"
End With
End Sub
Sub RemoveMenu()
' may be automatically executed from an Auto_Close macro or a Workbook_BeforeClose eventmacro
DeleteCustomCommandBarControl "JokerTag" ' deletes the new menu
End Sub
Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
' deletes ALL occurences of commandbar controls with a tag = CustomControlTag
On Error Resume Next
Do
Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
Loop Until Application.CommandBars.FindControl(, , CustomControlTag, False) Is Nothing
On Error GoTo 0
End Sub
------------------------------------------------------------------------------
I have a problem and i cant solve it.
I have the following code that is creating a menu.
I want when the submenu appears ("Choose Draws" in this occasion) and select it, to appears an textbox that it will read a value from the cell B1.
Then, when the user inserts a value, must be validated through a specific list which it will be, for example, in a range of cells A1:A10 with numbers 10 to 20. At last if the value is accepted will be copied to cell B1.
If the user press Esc, or leave the box empty then the value will be the same as before.
Thanks
-------------------------------------------------------------------------------
Option Explicit
Dim cbMenu As CommandBarControl
Dim cbSubMenu As CommandBarControl
Public MenuSeries
Public DrawsChoice As CommandBarComboBox
Sub CreateMenu()
' creates a new menu.
' can also be used to create commandbarbuttons
' may be automatically executed from an Aut
pen macro or a Workbook_Open eventmacroRemoveMenu ' delete the menu if it already exists
' create a new menu on an existing commandbar (the next 6 lines)
Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = "&Joker"
.Tag = "JokerTag"
.BeginGroup = False
End With
' or add to an existing menu (use the next line instead of the previous 6 lines)
'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Tools-menu
If cbMenu Is Nothing Then Exit Sub ' didn't find the menu...
' add a submenu to the submenu
Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = "&Choose Draws"
.Tag = "SubMenu2"
End With
'---
Set DrawsChoice = cbSubMenu.Controls.Add(msoControlEdit)
With DrawsChoice
.Caption = "::"
.OnAction = "Draws_Selection"
End With
End Sub
Sub RemoveMenu()
' may be automatically executed from an Auto_Close macro or a Workbook_BeforeClose eventmacro
DeleteCustomCommandBarControl "JokerTag" ' deletes the new menu
End Sub
Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
' deletes ALL occurences of commandbar controls with a tag = CustomControlTag
On Error Resume Next
Do
Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
Loop Until Application.CommandBars.FindControl(, , CustomControlTag, False) Is Nothing
On Error GoTo 0
End Sub
------------------------------------------------------------------------------
