Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
I copied the code from the article you suggested, however Case 4
gives an error - Method or data member not found (Error 461) in the line SubMenuItem.Controls.Add(Type:=msoControlButton) Any suggestions ? This is the code for Case 4: Case 4 ' A SubSubMenu Item Set SubSubMenuItem = SubMenuItem.Controls.Add(Type:=msoControlButton) SubSubMenuItem.Caption = Caption SubSubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubSubMenuItem.FaceId = FaceId If Divider Then SubSubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop -- HJN |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
Will definitely look into. Please let us know which version of Excel you are
using. If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I copied the code from the article you suggested, however Case 4 gives an error - Method or data member not found (Error 461) in the line SubMenuItem.Controls.Add(Type:=msoControlButton) Any suggestions ? This is the code for Case 4: Case 4 ' A SubSubMenu Item Set SubSubMenuItem = SubMenuItem.Controls.Add(Type:=msoControlButton) SubSubMenuItem.Caption = Caption SubSubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubSubMenuItem.FaceId = FaceId If Divider Then SubSubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop -- HJN |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
I use excel 2003
Tkank you much appreciated! -- HJN "Jacob Skaria" wrote: Will definitely look into. Please let us know which version of Excel you are using. If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I copied the code from the article you suggested, however Case 4 gives an error - Method or data member not found (Error 461) in the line SubMenuItem.Controls.Add(Type:=msoControlButton) Any suggestions ? This is the code for Case 4: Case 4 ' A SubSubMenu Item Set SubSubMenuItem = SubMenuItem.Controls.Add(Type:=msoControlButton) SubSubMenuItem.Caption = Caption SubSubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubSubMenuItem.FaceId = FaceId If Divider Then SubSubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop -- HJN |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
I got a chance to look into this only this morning...OK Shall we try this 5
level...You can add more as your requirement.... The below procedure looks into a table which will have details of the menus to be build. Currently it is targetted to the ActiveSheet. Please make necessary changes to that. The table format is as below with Row1 containing headers Unique menu ID, Menu Caption, Control Type (1 for button and 10 for popup) and Parent menu id. If parent menu id is 0 that menu will be created in level 1. The below table range is from A1:D16. Please try and feedback.... UID Caption Ctrl type Parent UID 1 Level1A 1 0 2 Level1B 10 0 3 Level1C 1 0 4 Level2A 1 2 5 Level2B 10 2 6 Level2C 1 2 7 Level3a 1 5 8 Level3b 10 5 9 Level3c 1 5 10 Level4a 1 8 11 Level4b 10 8 12 Level4c 1 8 13 Level5a 1 11 14 Level5b 1 11 15 Level5c 1 11 Sub AddMenus() Dim lngRow As Long Dim iHelpMenu As Integer Dim varMenuType As Variant Dim intMenuParent As Integer Dim strMacroName As String Dim strMainMenu As String Dim strMenuCaption As String Dim cbMainMenuBar As CommandBar Dim cbcCustomMenu As CommandBarControl Dim arrCustomMenu() As CommandBarControl lngRow = 2 strMainMenu = "MyMenu" On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete On Error GoTo 0 Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") iHelpMenu = cbMainMenuBar.Controls("Help").Index Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Befo=iHelpMenu) cbcCustomMenu.Caption = strMainMenu Do While ActiveSheet.Range("A" & lngRow) < "" ReDim Preserve arrCustomMenu(lngRow) strMenuCaption = Range("B" & lngRow) varMenuType = Range("C" & lngRow) intMenuParent = Range("D" & lngRow) strMacroName = Range("E" & lngRow) If intMenuParent = 0 Then Set arrCustomMenu(lngRow) = cbcCustomMenu.Controls.Add(Type:=varMenuType) arrCustomMenu(lngRow).Caption = strMenuCaption Else Set arrCustomMenu(lngRow) = arrCustomMenu(intMenuParent).Controls.Add(Type:=va rMenuType) arrCustomMenu(lngRow).Caption = strMenuCaption arrCustomMenu(lngRow).OnAction = strMacroName End If lngRow = lngRow + 1 Loop End Sub If this post helps click Yes --------------- Jacob Skaria |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
Oops...I have added the table headers just for your reference....The table
range should be in A1:D15 with no headers..... Also the starting row needs to be changed from 2 to 1 in code lngRow = 1 Please try and feedback..... If this post helps click Yes --------------- Jacob Skaria "Jacob Skaria" wrote: I got a chance to look into this only this morning...OK Shall we try this 5 level...You can add more as your requirement.... The below procedure looks into a table which will have details of the menus to be build. Currently it is targetted to the ActiveSheet. Please make necessary changes to that. The table format is as below with Row1 containing headers Unique menu ID, Menu Caption, Control Type (1 for button and 10 for popup) and Parent menu id. If parent menu id is 0 that menu will be created in level 1. The below table range is from A1:D16. Please try and feedback.... UID Caption Ctrl type Parent UID 1 Level1A 1 0 2 Level1B 10 0 3 Level1C 1 0 4 Level2A 1 2 5 Level2B 10 2 6 Level2C 1 2 7 Level3a 1 5 8 Level3b 10 5 9 Level3c 1 5 10 Level4a 1 8 11 Level4b 10 8 12 Level4c 1 8 13 Level5a 1 11 14 Level5b 1 11 15 Level5c 1 11 Sub AddMenus() Dim lngRow As Long Dim iHelpMenu As Integer Dim varMenuType As Variant Dim intMenuParent As Integer Dim strMacroName As String Dim strMainMenu As String Dim strMenuCaption As String Dim cbMainMenuBar As CommandBar Dim cbcCustomMenu As CommandBarControl Dim arrCustomMenu() As CommandBarControl lngRow = 2 strMainMenu = "MyMenu" On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete On Error GoTo 0 Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") iHelpMenu = cbMainMenuBar.Controls("Help").Index Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Befo=iHelpMenu) cbcCustomMenu.Caption = strMainMenu Do While ActiveSheet.Range("A" & lngRow) < "" ReDim Preserve arrCustomMenu(lngRow) strMenuCaption = Range("B" & lngRow) varMenuType = Range("C" & lngRow) intMenuParent = Range("D" & lngRow) strMacroName = Range("E" & lngRow) If intMenuParent = 0 Then Set arrCustomMenu(lngRow) = cbcCustomMenu.Controls.Add(Type:=varMenuType) arrCustomMenu(lngRow).Caption = strMenuCaption Else Set arrCustomMenu(lngRow) = arrCustomMenu(intMenuParent).Controls.Add(Type:=va rMenuType) arrCustomMenu(lngRow).Caption = strMenuCaption arrCustomMenu(lngRow).OnAction = strMacroName End If lngRow = lngRow + 1 Loop End Sub If this post helps click Yes --------------- Jacob Skaria |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
I have revised the code and added more comments. CreateMenu is a separate
procedure which can be called from code like below. Two arguments to be passed are the menu name and the worksheet in which you have the details...The main menu will be created just before the help menu. The macro name is to be in the 5th column of the worksheet. CreateMenu "MyNewMenu",Activeworkbook.Sheets("Sheet1") Sub CreateMenu(strMainMenu As String, wsMenu As Worksheet) 'Procedure to create an Excel Menu and multiple levels of sub menus '-------------------Arguments----------------------------- 'strMainMenu - The Main menu caption to be passed 'wsMenu - Worksheet in which menu details are stored(5 fields) 'Unique MenuID, Caption, Menu type,Parent Menu ID, Macro Dim lngRow As Long 'Start Row Dim intMenuID As Integer 'Unique menu ID Dim intMenuPID As Integer 'Parent menu ID Dim intHelpMenu As Integer 'Help menu index Dim varMenuType As Variant 'Menu type (1,10) Dim strMacroName As String 'Macro to be assigned Dim strMenuCaption As String 'Menu captions Dim cbMainMenuBar As CommandBar 'Command Bar Dim arrCBC() As CommandBarControl 'Command Bar control Array lngRow = 2 ReDim arrCBC(0) 'Remove if the menu already exists On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete On Error GoTo 0 'Identify menu location just before Help menu Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") intHelpMenu = cbMainMenuBar.Controls("Help").Index 'Create main menu Set arrCBC(0) = cbMainMenuBar.Controls.Add(Type:=10, Befo=intHelpMenu) arrCBC(0).Caption = strMainMenu 'Create sub menus Do While wsMenu.Range("A" & lngRow) < "" intMenuID = wsMenu.Range("A" & lngRow) ReDim Preserve arrCBC(intMenuID) strMenuCaption = wsMenu.Range("B" & lngRow) varMenuType = wsMenu.Range("C" & lngRow) intMenuPID = wsMenu.Range("D" & lngRow) strMacroName = wsMenu.Range("E" & lngRow) Set arrCBC(intMenuID) = arrCBC(intMenuPID).Controls.Add(Type:=varMenuType) arrCBC(intMenuID).Caption = strMenuCaption If intMenuPID 0 Then arrCBC(intMenuID).OnAction = strMacroName End If lngRow = lngRow + 1 Loop End Sub If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I use excel 2003 Tkank you much appreciated! -- HJN "Jacob Skaria" wrote: Will definitely look into. Please let us know which version of Excel you are using. If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I copied the code from the article you suggested, however Case 4 gives an error - Method or data member not found (Error 461) in the line SubMenuItem.Controls.Add(Type:=msoControlButton) Any suggestions ? This is the code for Case 4: Case 4 ' A SubSubMenu Item Set SubSubMenuItem = SubMenuItem.Controls.Add(Type:=msoControlButton) SubSubMenuItem.Caption = Caption SubSubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubSubMenuItem.FaceId = FaceId If Divider Then SubSubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop -- HJN |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
Jacob, Thank you very much, it works perfectly!. By the way - I posed the
question to the author (John Weilbach) who said its not worth the trouble! -- HJN "Jacob Skaria" wrote: I have revised the code and added more comments. CreateMenu is a separate procedure which can be called from code like below. Two arguments to be passed are the menu name and the worksheet in which you have the details...The main menu will be created just before the help menu. The macro name is to be in the 5th column of the worksheet. CreateMenu "MyNewMenu",Activeworkbook.Sheets("Sheet1") Sub CreateMenu(strMainMenu As String, wsMenu As Worksheet) 'Procedure to create an Excel Menu and multiple levels of sub menus '-------------------Arguments----------------------------- 'strMainMenu - The Main menu caption to be passed 'wsMenu - Worksheet in which menu details are stored(5 fields) 'Unique MenuID, Caption, Menu type,Parent Menu ID, Macro Dim lngRow As Long 'Start Row Dim intMenuID As Integer 'Unique menu ID Dim intMenuPID As Integer 'Parent menu ID Dim intHelpMenu As Integer 'Help menu index Dim varMenuType As Variant 'Menu type (1,10) Dim strMacroName As String 'Macro to be assigned Dim strMenuCaption As String 'Menu captions Dim cbMainMenuBar As CommandBar 'Command Bar Dim arrCBC() As CommandBarControl 'Command Bar control Array lngRow = 2 ReDim arrCBC(0) 'Remove if the menu already exists On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete On Error GoTo 0 'Identify menu location just before Help menu Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") intHelpMenu = cbMainMenuBar.Controls("Help").Index 'Create main menu Set arrCBC(0) = cbMainMenuBar.Controls.Add(Type:=10, Befo=intHelpMenu) arrCBC(0).Caption = strMainMenu 'Create sub menus Do While wsMenu.Range("A" & lngRow) < "" intMenuID = wsMenu.Range("A" & lngRow) ReDim Preserve arrCBC(intMenuID) strMenuCaption = wsMenu.Range("B" & lngRow) varMenuType = wsMenu.Range("C" & lngRow) intMenuPID = wsMenu.Range("D" & lngRow) strMacroName = wsMenu.Range("E" & lngRow) Set arrCBC(intMenuID) = arrCBC(intMenuPID).Controls.Add(Type:=varMenuType) arrCBC(intMenuID).Caption = strMenuCaption If intMenuPID 0 Then arrCBC(intMenuID).OnAction = strMacroName End If lngRow = lngRow + 1 Loop End Sub If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I use excel 2003 Tkank you much appreciated! -- HJN "Jacob Skaria" wrote: Will definitely look into. Please let us know which version of Excel you are using. If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I copied the code from the article you suggested, however Case 4 gives an error - Method or data member not found (Error 461) in the line SubMenuItem.Controls.Add(Type:=msoControlButton) Any suggestions ? This is the code for Case 4: Case 4 ' A SubSubMenu Item Set SubSubMenuItem = SubMenuItem.Controls.Add(Type:=msoControlButton) SubSubMenuItem.Caption = Caption SubSubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubSubMenuItem.FaceId = FaceId If Divider Then SubSubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop -- HJN |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Menu creater - Jacob Skaria
Dear Hennie
Thanks for the feedback. Your query was something very interesting to work with.. If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: Jacob, Thank you very much, it works perfectly!. By the way - I posed the question to the author (John Weilbach) who said its not worth the trouble! -- HJN "Jacob Skaria" wrote: I have revised the code and added more comments. CreateMenu is a separate procedure which can be called from code like below. Two arguments to be passed are the menu name and the worksheet in which you have the details...The main menu will be created just before the help menu. The macro name is to be in the 5th column of the worksheet. CreateMenu "MyNewMenu",Activeworkbook.Sheets("Sheet1") Sub CreateMenu(strMainMenu As String, wsMenu As Worksheet) 'Procedure to create an Excel Menu and multiple levels of sub menus '-------------------Arguments----------------------------- 'strMainMenu - The Main menu caption to be passed 'wsMenu - Worksheet in which menu details are stored(5 fields) 'Unique MenuID, Caption, Menu type,Parent Menu ID, Macro Dim lngRow As Long 'Start Row Dim intMenuID As Integer 'Unique menu ID Dim intMenuPID As Integer 'Parent menu ID Dim intHelpMenu As Integer 'Help menu index Dim varMenuType As Variant 'Menu type (1,10) Dim strMacroName As String 'Macro to be assigned Dim strMenuCaption As String 'Menu captions Dim cbMainMenuBar As CommandBar 'Command Bar Dim arrCBC() As CommandBarControl 'Command Bar control Array lngRow = 2 ReDim arrCBC(0) 'Remove if the menu already exists On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete On Error GoTo 0 'Identify menu location just before Help menu Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") intHelpMenu = cbMainMenuBar.Controls("Help").Index 'Create main menu Set arrCBC(0) = cbMainMenuBar.Controls.Add(Type:=10, Befo=intHelpMenu) arrCBC(0).Caption = strMainMenu 'Create sub menus Do While wsMenu.Range("A" & lngRow) < "" intMenuID = wsMenu.Range("A" & lngRow) ReDim Preserve arrCBC(intMenuID) strMenuCaption = wsMenu.Range("B" & lngRow) varMenuType = wsMenu.Range("C" & lngRow) intMenuPID = wsMenu.Range("D" & lngRow) strMacroName = wsMenu.Range("E" & lngRow) Set arrCBC(intMenuID) = arrCBC(intMenuPID).Controls.Add(Type:=varMenuType) arrCBC(intMenuID).Caption = strMenuCaption If intMenuPID 0 Then arrCBC(intMenuID).OnAction = strMacroName End If lngRow = lngRow + 1 Loop End Sub If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I use excel 2003 Tkank you much appreciated! -- HJN "Jacob Skaria" wrote: Will definitely look into. Please let us know which version of Excel you are using. If this post helps click Yes --------------- Jacob Skaria "Hennie Neuhoff" wrote: I copied the code from the article you suggested, however Case 4 gives an error - Method or data member not found (Error 461) in the line SubMenuItem.Controls.Add(Type:=msoControlButton) Any suggestions ? This is the code for Case 4: Case 4 ' A SubSubMenu Item Set SubSubMenuItem = SubMenuItem.Controls.Add(Type:=msoControlButton) SubSubMenuItem.Caption = Caption SubSubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubSubMenuItem.FaceId = FaceId If Divider Then SubSubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop -- HJN |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro Help - Jacob Skaria has previously been helping | Excel Discussion (Misc queries) | |||
Congratulations, Jacob Skaria... | Excel Discussion (Misc queries) | |||
Previously helped by Jacob Skaria -- need more help | Excel Discussion (Misc queries) | |||
Ping Jacob Skaria | Excel Worksheet Functions | |||
Menu creater - Dave Peterson | Excel Programming |