VBA : Create Dynamic commandbar (Menu Bar) in Excel :Easy to change

Create Dynamic commandbar (Menu Bar) in Excel :Easy to change

First add the "Microsoft windows common control 6.0"

Name the sheet as "Menus"

	A	B	C	D	E	F	G
1	Level	Caption	Position/Macro	Divider	FaceID	Control Type	Checkbox
2	1	My Menu	10			0	0
3	2	&Day		TRUE		0	0
4	3	&Sunday	Module3.cmd1		453	0	0
5	3	&Monday	Module3.cmd2		195	0	0
6	3	&Tuesday	Module3.cmd3		2128	1	0
7	2	&Month		TRUE		0	0
8	3	&Jan	Module3.cmd4		3203	0	0
9	2	&Car		TRUE		0	0
10	3	&BMW	Module3.cmd5			0	1

and call below module on workbook_open event 

Sub CreateMenu()
'   This sub should be executed when the workbook is opened.
'   NOTE: There is no error handling in this subroutine

    Dim MenuSheet As Worksheet
    Dim MenuObject As CommandBarPopup

    Dim MenuItem As Object
    Dim submenuitem As CommandBarButton
    'Dim submenuitem1 As CommandBarControl
    Dim Row As Integer
    Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId, cntType, Chkflg

''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Location for menu data
    Set MenuSheet = ThisWorkbook.Sheets("Menus")
''''''''''''''''''''''''''''''''''''''''''''''''''''

'   Make sure the menus aren't duplicated
    Call DeleteMenu
  
'   Initialize the row counter
    Row = 2

'   Add the menus, menu items and submenu items using
'   data stored on MenuSheet
  
    Do Until IsEmpty(MenuSheet.Cells(Row, 1))
        With MenuSheet
            MenuLevel = .Cells(Row, 1)
            Caption = .Cells(Row, 2)
            PositionOrMacro = .Cells(Row, 3)
            Divider = .Cells(Row, 4)
            FaceId = .Cells(Row, 5)
            NextLevel = .Cells(Row + 1, 1)
            cntType = .Cells(Row, 6)
            Chkflg = .Cells(Row, 6)
        End With
      
        Select Case MenuLevel
            Case 1 ' A Menu
'              Add the top-level menu to the Worksheet CommandBar
                Set MenuObject = Application.CommandBars(1). _
                    Controls.Add(Type:=msoControlPopup, _
                    Before:=PositionOrMacro, _
                    Temporary:=True)
                MenuObject.Caption = Caption
          
            Case 2 ' A Menu Item
                If NextLevel = 3 Then
                    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = PositionOrMacro
                End If
                MenuItem.Caption = Caption
                If FaceId <> "" Then MenuItem.FaceId = FaceId
                If Divider Then MenuItem.BeginGroup = True
          
            Case 3 ' A SubMenu Item
                  
                    Select Case cntType
                  
                    Case 0
                        With MenuItem.Controls.Add(Type:=msoControlButton)
                                .Caption = Caption
                                .OnAction = PositionOrMacro
                                If Chkflg = 1 Then .State = msoButtonUp
                                If FaceId <> "" Then .FaceId = FaceId
                                If Divider Then .BeginGroup = True
                              
                        End With
                    Case 1
                        With MenuItem.Controls.Add(Type:=msoControlEdit)
                                .Caption = Caption
                                .OnAction = PositionOrMacro
                              
                                'If FaceId <> "" Then .FaceId = FaceId
                                If Divider Then .BeginGroup = True
                              
                      
                      
                        End With
                    Case 2
                  
                    End Select
               

              
                      
        End Select
      
        Row = Row + 1
    Loop
End Sub

Sub DeleteMenu()
'   This sub should be executed when the workbook is closed
'   Deletes the Menus
    Dim MenuSheet As Worksheet
    Dim Row As Integer
    Dim Caption As String
  
    On Error Resume Next
    Set MenuSheet = ThisWorkbook.Sheets("Menus")
    Row = 2
    Do Until IsEmpty(MenuSheet.Cells(Row, 1))
        If MenuSheet.Cells(Row, 1) = 1 Then
            Caption = MenuSheet.Cells(Row, 2)
            Application.CommandBars(1).Controls(Caption).Delete
        End If
        Row = Row + 1
    Loop
    On Error GoTo 0
End Sub