xla create menubar

[o0o]

hi các bạn,

Mình cần create thêm menubar để thêm các Add-in cần thiết.
Tuy nhiên file xla mình vừa create (chỉ mới có phần addmenu thoi), khi run bang double-click file thi Menubar cần tạo vẫn không được add thêm.
Cần phải setting thêm gì khác không nhỉ ?

Mong các bạn giúp đỡ.

Code chỉ mới thế này thôi:

Option Explicit

Private Sub CB_open()
    Dim NewMenu As CommandBarControl
    Dim NewItem As CommandBarButton
    If FindMenuBar("CB check") = False Then
        ' Add a new menu
        Set NewMenu = CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, before:=10)
        NewMenu.Caption = "CB check"
        
        ' Add a new menu item
        Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
        With NewItem
            .Caption = "&Check Source CB"
            .OnAction = "Check_Source"
            .Enabled = True
        End With
        
        ' Add a new menu item
        Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
        With NewItem
            .Caption = "&Help"
            .OnAction = "ShowHelp"
            .Enabled = True
        End With
        
        ' Add a new menu item
        Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
        With NewItem
            .Caption = "&Delete Menu"
            .OnAction = "addMenu.reset"
            .Enabled = True
        End With
    End If
End Sub

 

[o0o]

Xin lỗi mọi người vì đã làm phiền. Mình đã thực hiện được.
Mình sửa lại như bên dưới:

Public Const CB_Check_menubar = "CB check"
Public Const CB_Check_menuitem = "&Check S CB"
Public Const CB_Check_menuaction = "Check_S"
Public Const RESET_menuitem = "&Delete Menu"
Public Const RESET_menuaction = "addMenu.reset"
Private Sub auto_open()
On Error Resume Next
    
    Dim NewMenu              As Object
    Dim MenuItem0, MenuItem1 As Object
    
    If FindMenuBar(CB_Check_menubar) = False Then
        ' Add a new menu
        Set NewMenu = CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, before:=10)
        NewMenu.Caption = CB_Check_menubar
        
        ' Add a new menu item
        Set MenuItem0 = NewMenu.Controls.Add
            MenuItem0.Caption = CB_Check_menuitem
            MenuItem0.OnAction = CB_Check_menuaction
            MenuItem0.FaceId = 25
            MenuItem0.Enabled = True
        
        ' Add a new menu item
        Set MenuItem1 = NewMenu.Controls.Add
            MenuItem1.Caption = RESET_menuitem
            MenuItem1.OnAction = "ReSet"
            MenuItem1.FaceId = 52
            MenuItem1.Enabled = True
    End If
End Sub
'Search exist menubar
Private Function FindMenuBar(strMenuBar As String) As Boolean
    Dim iMenu               As Object
    
    For Each iMenu In MenuBars(xlWorksheet).Menus
        If iMenu.Caption = strMenuBar Then
            FindMenuBar = True
            Exit Function
        End If
    Next iMenu
    FindMenuBar = False
End Function

 

[TrungChinhs]

Cái này sử dụng như thế nào nhỉ ? Mình không biết cách test. Bạn nào biết cho mình xin một file ví dụ. Thanks !

 

[sealand]

Bạn cứ thêm 1 module rồi chép nó vào-->lưu lại-->thoát ra.
Khi mở lại file sub Auto_open sẽ load bổ xung 1 menu thôi