Public Const TenMenuSheet = "MenuSheet"
' Ten sheet chua du lieu de tao Menu
Public Const ToolBarMenuName = "XuanThienthietke"
Public Const TenWB As String = "MS_0807.xls"
' Ten cua ToolBar Menu
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TAO VA DELETE MENU
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Thu tuc nay duoc tong hop lai vao ngay 31/10/2004
' nham tao 3 loai menu dua tren du lieu o Sheet Menu
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateMenuAll(Optional CreateMenuBar As Boolean, _
Optional CreateShortcutMenu As Boolean, _
Optional CreateToolBarMenu As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''
' Khai bao bien cho CreateMenuBar
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''
' Khai bao bien cho CreateShortcutMenu
Dim MenuSCControl As CommandBarControl
''''''''''''''''''''''''''''''''''''''''''''''''''
' Khai bao bien cho CreateShortcutMenu
Dim ToolBarMenu As CommandBar
Dim ToolbarMenuControl As CommandBarControl
''''''''''''''''''''''''''''''''''''''''''''''''''
' Kiem tra ActiveWorkbook truoc khi thuc hien
If ActiveWorkbook.Name <> TenWB Then
Exit Sub
End If
' Assign default value if the argument is missing
' Dua cac gia tri mac dinh vao neu cac doi so khong dua vao
If IsMissing(CreateMenuBar) Then CreateMenuBar = False
If IsMissing(CreateShortcutMenu) Then CreateShortcutMenu = False
If IsMissing(CreateToolBarMenu) Then CreateToolBarMenu = False
' Trong truong hop CreateMenuBar=True
If CreateMenuBar = True Then
''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
' Chi dinh Sheet de lay du lieu cho Menu
Set MenuSheet = ThisWorkbook.Sheets(MenuSheet)
''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the menus aren't duplicated
' De chac chan rang Menu khong bi trung lap
Call DeleteMenuAll(True, False, False)
' Initialize the row counter; Hang bat dau la hang thu 2
Row = 2
' Add the menus, menu items and submenu items using
' data stored on MenuSheet
' Dua vao du lieu tren MenuSheet ma xay dung Menu
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)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
' Menu cap mot
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
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End If
' Trong truong hop CreateShortcutMenu=True
If CreateShortcutMenu = True Then
''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for shortcutmenu data
' Chi dinh Sheet de lay du lieu cho ShortcutMenu
Set MenuSheet = ThisWorkbook.Sheets(TenMenuSheet)
''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the shortcut menus aren't duplicated
' De chac chan rang Shortcut Menu khong bi trung lap
Call DeleteMenuAll(False, True, False)
' Initialize the row counter; Hang bat dau la hang thu 2
Row = 2
' Add the shortcut menus, shortcutmenu items
' and subshortcutmenu items using
' data stored on MenuSheet
' Dua vao du lieu tren MenuSheet ma xay dung Menu
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)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level shortcut menu to the Cell CommandBar
' Menu cap mot
Set MenuSCControl = Application.CommandBars("Cell"). _
Controls.Add(Type:=msoControlPopup)
MenuSCControl.Caption = Caption
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem = MenuSCControl.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = MenuSCControl.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
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End If
If CreateToolBarMenu = True Then
''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
' Chi dinh Sheet de lay du lieu cho Menu
Set MenuSheet = ThisWorkbook.Sheets(TenMenuSheet)
''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the Toolbar menus aren't duplicated
' De chac chan rang Toolbar Menu khong bi trung lap
Call DeleteMenuAll(False, False, True)
' Create Toolbar
Set ToolBarMenu = Application.CommandBars.Add
With ToolBarMenu
.Visible = False
.Name = ToolBarMenuName
.Position = msoBarTop
.Protection = msoBarNoCustomize
End With
' Initialize the row counter; Hang bat dau la hang thu 2
Row = 2
' Add the Toolbar menus, Toolbar menu items and submenu items using
' data stored on MenuSheet
' Dua vao du lieu tren MenuSheet ma xay dung Menu
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)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level shortcut menu to the Cell CommandBar
' Menu cap mot
Set ToolbarMenuControl = Application.CommandBars(ToolBarMenuName). _
Controls.Add(Type:=msoControlPopup)
ToolbarMenuControl.Caption = Caption
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem = ToolbarMenuControl.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = ToolbarMenuControl.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
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
ToolBarMenu.Visible = True
End If
End Sub
'........
...........
End Sub
