Сам нашел , даю решение, может быть, кому-нибудь и пригодится:

Sub AddMenuToMenuBar(vsoApplication As Visio.Application)
' Abstract - This procedure gets the active MenuBar from
' Visio and adds a Menu at the end called "Custom".

        Dim cbrCommandBars  As Office.CommandBars
    Dim cbrMenuBar      As Office.CommandBar
    Dim cbrMenuPopup    As Office.CommandBarPopup
    Dim cbrMenuPopup_Group    As Office.CommandBarPopup
    
    Dim cbrFilePopup    As Office.CommandBar
    Dim cbbMenuItem     As Office.CommandBarButton
    Dim cbbOpen         As Office.CommandBarButton
    Dim XID As Integer
    
    
    ' Get the CommandBars collection from Visio.
    Set cbrCommandBars = Application.CommandBars
    
    ' Get the active menu bar from the CommandBars
    ' collection.
    Set cbrMenuBar = cbrCommandBars.ActiveMenuBar
    
    ' Add a pop-up menu to the end of the menu bar.
    Set cbrMenuPopup = cbrMenuBar.Controls.Add( _
        Type:=msoControlPopup, _
        Temporary:=True)
    cbrMenuPopup.Caption = "тест"
       
    
     ' Get the ID of the "File/Open..." MenuItem
    Set cbrFilePopup = cbrCommandBars.Item("File")
    Set cbbOpen = cbrFilePopup.Controls.Item(2)
    
    ' Add a MenuItem with the ID of "File/Open...".
    Set cbbMenuItem = cbrMenuPopup.Controls.Add( _
        Type:=msoControlButton, _
        ID:=cbbOpen.ID, Temporary:=True)
        
    ' Set the caption for the MenuItem.
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.Style = msoButtonCaption
    cbbMenuItem.Visible = True
    cbbMenuItem.OnAction = "ShowNum"
    
    Set cbrMenuPopup_Group = cbrMenuPopup.Controls.Add( _
        Type:=msoControlPopup, Temporary:=True)
        

    cbrMenuPopup_Group.Caption = "тест"
    
    Set cbbMenuItem = Application.CommandBars(cbrMenuPopup_Group.CommandBar.Name).Controls.Add
        
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.OnAction = "GetAllObjects"
    
    Set cbbMenuItem = Application.CommandBars(cbrMenuPopup_Group.CommandBar.Name).Controls.Add
    
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.OnAction = "GetAllObjectsFromActivePage"
       
    Set cbbMenuItem = Application.CommandBars(cbrMenuPopup_Group.CommandBar.Name).Controls.Add
        
    
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.OnAction = "GetAllProcedures"
    cbbMenuItem.BeginGroup = True
    
    Set cbbMenuItem = Application.CommandBars(cbrMenuPopup_Group.CommandBar.Name).Controls.Add
    
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.OnAction = "GetProceduresFromActivePage"
    
    Set cbbMenuItem = Application.CommandBars(cbrMenuPopup_Group.CommandBar.Name).Controls.Add
        
    ' Set the caption for the MenuItem.
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.OnAction = "GetAllSwitches"
    cbbMenuItem.BeginGroup = True
    
    Set cbbMenuItem = cbrMenuPopup.Controls.Add( _
        Type:=msoControlButton, _
        ID:=cbbOpen.ID, Temporary:=True)
        
    ' Set the caption for the MenuItem.
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.Style = msoButtonCaption
    cbbMenuItem.Visible = True
    cbbMenuItem.OnAction = "ShowViewTXT"
    cbbMenuItem.BeginGroup = True
    
    
    Set cbbMenuItem = cbrMenuPopup.Controls.Add( _
        Type:=msoControlButton, _
        ID:=cbbOpen.ID, Temporary:=True)
    
    cbbMenuItem.Caption = "тест"
    cbbMenuItem.Style = msoButtonCaption
    cbbMenuItem.Visible = True
    cbbMenuItem.OnAction = "ShowTP"
    
    Exit Sub

    
AddMenuItemToMenuBar_Err:
    MsgBox Err.Description
    
End Sub