With Application.CommandBars(3).Controls.Add(Type:=msoControlButton) 
     .FaceId = 42 
     .Caption = "Кнопка" 
     .OnAction = "Макрос" 
End With

With Application.Toolbars(1).ToolbarButtons.Add(Button:=222) 
     .Name = "Кнопка" 
     .OnAction = "Макрос" 
End With

Private Sub Workbook_Activate() 
With Application.CommandBars("Cell") 
     .Protection = msoBarNoProtection 
     With .Controls.Add(Type:=msoControlButton) 
          .Caption = "Поиск данных ячейки" 
          .OnAction = Me.CodeName & ".Dialog_CellFind" 
          .BeginGroup = True 
     End With 
     .Enabled = True 
End With 
End Sub 

Private Sub Workbook_Deactivate() 
With Application.CommandBars("Cell") 
     .Controls(.Controls.Count).Delete 
End With 
End Sub 

Private Sub Dialog_CellFind() 
With Application 
     .Dialogs(xlDialogFormulaFind).Show _ 
     Arg1:=.ActiveCell.Value, Arg2:=2, Arg6:=True 
End With 
End Sub

Private Sub Workbook_Activate() 
With Application.ShortcutMenus(xlWorksheetCell) 
     .MenuItems.Add Caption:="-" 
     .MenuItems.Add Caption:="Поиск данных ячейки", _ 
     OnAction:=Me.CodeName & ".Dialog_CellFind" 
End With 
End Sub 

Private Sub Workbook_Deactivate() 
With Application.ShortcutMenus(xlWorksheetCell) 
     .MenuItems(.MenuItems.Count).Delete 
End With 
End Sub 

Private Sub Dialog_CellFind() 
With Application 
     .Dialogs(xlDialogFormulaFind).Show _ 
     Arg1:=.ActiveCell.Value, Arg2:=2, Arg6:=True 
End With 
End Sub

Private Sub Auto_Open() 
With Application.CommandBars("Ply") 
     .Protection = msoBarNoProtection 
     With .Controls.Add(Before:=1, Temporary:=True) 'Type:=Optional 
          .Caption = "Диалог переименования" 
          .OnAction = "Dialog_WorksheetName" 
     End With 
     .Enabled = True 
End With 
End Sub 

Private Sub Dialog_WorksheetName() 
If Not ThisWorkbook.ProtectStructure Then 
   Application.Dialogs(xlDialogWorkbookName).Show 
Else 
   MsgBox "Вы не можете переименовать рабочий лист" 
End If 
End Sub

Private Sub Auto_Open() 
With Application.ShortcutMenus(xlWorkbookTab) 
     .MenuItems.Add(Caption:="Диалог переименования", _ 
     Before:=1).OnAction = "DialogsWorksheetName" 
End With 
End Sub 

Private Sub DialogsWorksheetName() 
If Not ActiveWorkbook.ProtectStructure Then 
   Application.Dialogs(xlDialogWorkbookName).Show 
Else 
   MsgBox "Вы не можете переименовать рабочий лист" 
End If 
End Sub

Private Sub CommandBar_Cell_Change() 
With Application.CommandBars("Cell") 
     .Reset: .Enabled = True 
     .Protection = msoBarNoProtection 
     .Controls.Add Id:=369, Before:=4 
     .Controls.Add Id:=370, Before:=5 
End With 
End Sub

Private Sub CommandBar_Ply_Change() 
With Application.CommandBars("Ply") 
     .Reset: .Enabled = True 
     .Protection = msoBarNoProtection 
     With .Controls.Add(Id:=852, Before:=3) 
          .Caption = "Вставить лист" 
          .Style = msoButtonCaption 
     End With 
     .Controls.Add(Id:=890, Before:=4).Caption = "Скрыть лист" 
     .Controls.Add Id:=891, Before:=5 
End With 
End Sub

Private Sub Auto_Open() 
    With Application.CommandBars("AutoCalculate") 
         .Reset: .Enabled = True 
         .Protection = msoBarNoProtection 
         For Each iFunction In Array( _ 
         "Количество символов", "Количество значений", _ 
         "Количество чисел", "Максимум", "Минимум", "Среднее", "Сумма") 
             With .Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True) 
                  .Tag = iFunction 
                  .Caption = iFunction & " (всех ячеек)" 
                  .OnAction = "EvaluateFunction" 
             End With 
         Next 
         .Controls(8).BeginGroup = True 
    End With 
End Sub

Private Sub EvaluateFunction() 
    With Application 
         If TypeOf .Selection Is Range Then 
            iAddress$ = .Selection.Address 
            iCaption$ = .CommandBars.ActionControl.Tag 
            iFunction = Switch( _ 
            iCaption$ = "Сумма", "SUM(XYZ)", _ 
            iCaption$ = "Минимум", "MIN(XYZ)", _ 
            iCaption$ = "Максимум", "MAX(XYZ)", _ 
            iCaption$ = "Среднее", "AVERAGE(XYZ)", _ 
            iCaption$ = "Количество чисел", "COUNT(XYZ)", _ 
            iCaption$ = "Количество значений", "COUNTA(XYZ)", _ 
            iCaption$ = "Количество символов", "SUM(LEN(XYZ))") 
            If Not IsNull(iFunction) Then 
               iFormula$ = .Substitute(iFunction, "XYZ", iAddress$) 
               iResult = .Evaluate(iFormula$) 
               If Not IsError(iResult) Then _ 
                  MsgBox iCaption$ & "=" & iResult, , iAddress$ 
            End If 
         End If 
    End With 
End Sub

Private Sub EvaluateFunction() 
    With Application 
         If TypeOf .Selection Is Range Then 
            iAddress$ = .Selection.Address 
            iCaption$ = .CommandBars.ActionControl.Tag 
            Select Case iCaption$ 
                Case "Сумма":               iResult = .Sum(.Selection) 
                Case "Минимум":             iResult = .Min(.Selection) 
                Case "Максимум":            iResult = .Max(.Selection) 
                Case "Среднее":             iResult = .Average(.Selection) 
                Case "Количество чисел":    iResult = .Count(.Selection) 
                Case "Количество значений": iResult = .CountA(.Selection) 
                Case "Количество символов": 
                iResult = .Evaluate("SUM(LEN(" & iAddress$ & "))") 
            End Select 
            If .IsNumber(iResult) = True Then _ 
               MsgBox iCaption$ & "=" & iResult, , iAddress$ 
         End If 
    End With 
End Sub

With Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, Temporary:=True) 
     .Caption = "Архив" 
     With .Controls 
          With .Add(Type:=msoControlButton) 
               .FaceId = 280 
               .Caption = "Просмотр" 
               .OnAction = "Макрос1" 
          End With 
          With .Add(Type:=msoControlPopup) 
               .Caption = "База данных" 
               With .Controls 
                    With .Add(Type:=msoControlButton) 
                         .FaceId = 1643 
                         .Caption = "Поставщики" 
                         .OnAction = "Макрос2" 
                    End With 
                    With .Add(Type:=msoControlButton) 
                         .FaceId = 1000 
                         .Caption = "Покупатели" 
                         .OnAction = "Макрос3" 
                    End With 
               End With 
          End With 
     End With 
End With

With MenuBars("Worksheet").Menus.Add(Caption:="Архив") 
     .MenuItems.Add Caption:="Просмотр", OnAction:="Макрос1" 
     With .MenuItems.AddMenu(Caption:="База данных") 
          .MenuItems.Add Caption:="Поставщики", OnAction:="Макрос2" 
          .MenuItems.Add Caption:="Покупатели", OnAction:="Макрос3" 
     End With 
End With

With MenuBars("Worksheet").Menus.Add(Caption:="Архив") 
     With .MenuItems.Add(Caption:="Просмотр") 
          .OnAction = "Макрос1" 
     End With 
     With .MenuItems.AddMenu(Caption:="База данных") 
          With .MenuItems.Add(Caption:="Поставщики") 
               .OnAction = "Макрос2" 
          End With 
          With .MenuItems.Add(Caption:="Покупатели") 
               .OnAction = "Макрос3" 
          End With 
     End With 
End With

With Application.CommandBars.Add(Name:="MyContextMenu", Position:=msoBarPopup, Temporary:=True) 
     With .Controls.Add(Type:=msoControlButton) 
          .Style = msoButtonIconAndCaption 
          .FaceId = 71 
          .Caption = "Первая кнопка" 
          .OnAction = "Макрос1" 
     End With 
     With .Controls.Add(Type:=msoControlButton) 
          .Style = msoButtonIconAndCaption 
          .FaceId = 72 
          .Caption = "Вторая кнопка" 
          .OnAction = "Макрос2" 
     End With 
     With .Controls.Add(Type:=msoControlButton) 
          .Style = msoButtonIconAndCaption 
          .FaceId = 73 
          .Caption = "Вторая кнопка" 
          .OnAction = "Макрос3" 
     End With 
     'и т.д. 
     .ShowPopup X:=100, Y:=150 '.ShowPopup 
End With

Application.CommandBars("Cell").ShowPopup
Application.CommandBars("Cell").ShowPopup X:=0, Y:=0

Application.CommandBars("MyContextMenu").ShowPopup
Application.CommandBars("MyContextMenu").ShowPopup X:=100, Y:=100

Private Sub CreateContextMenu()
    Application.CommandBars. _
    Add(, msoBarPopup, , True).Controls. _
    Add.Caption = "Пример, где используется номер/индекс"
End Sub

Private Sub ShowContextMenu()
    With Application.CommandBars
         .Item(.Count).ShowPopup 'ShowPopup 100, 100
    End With
End Sub

With Application.CommandBars.Add(Name:="Панель", Temporary:=True) 
     With .Controls.Add(Type:=msoControlButton) 
          .Style = msoButtonIconAndCaption 
          .FaceId = 66 
          .Caption = "Просто кнопка" 
     End With 
     .Visible = True 
End With

With Application.CommandBars.Add(Name:="Левая Панель", Position:=msoBarLeft, Temporary:=True) 
     .Visible = True 
     With .Controls 
          With .Add(msoControlButton) 
               .Style = msoButtonWrapCaption 
               .Caption = "Просто кнопка" 
          End With 
          With .Add(msoControlButton) 
               .Style = msoButtonIconAndWrapCaption 
               .Caption = "Кнопка" 
               .FaceId = 225 
          End With 
     End With 
End With

With Application.CommandBars.Add(Temporary:=True) 
     With .Controls 
          With .Add(msoControlButton) 
               .Style = msoButtonWrapCaption 
               .Caption = "Кнопка" 
          End With 
     End With 
     .Name = "Правая Панель" 
     .Position = msoBarRight 
     .Visible = True 
End With

If Application.CommandBars(3).Type = msoBarTypePopup Then 
   MsgBox "Это действительно контекстное меню", , "" 
Else 
   MsgBox "Эта панель инструментов не является контексным меню", , "" 
End If 

If Application.CommandBars("Cell").Type = msoBarTypePopup Then 
   MsgBox "Это действительно контекстное меню", , "" 
Else 
   MsgBox "Эта панель инструментов не является контексным меню", , "" 
End If

With Application.CommandBars 
     With .Item("Standard") ' или .Item(3) 
          .Enabled = True: .Visible = True 
          iLeft& = .Width: iRowIndex& = .RowIndex 
     End With 
     With .Add(Name:="Панель", Position:=msoBarTop, Temporary:=True) 
          .RowIndex = iRowIndex&: .Left = iLeft& 

          .Controls.Add.FaceId = 98 
          .Controls.Add.FaceId = 80 
          .Controls.Add.FaceId = 92 
          .Controls.Add.FaceId = 95 
          .Controls.Add.FaceId = 91 
          .Controls.Add.FaceId = 84 
          'Создание этих кнопок всего лишь имитация Ваших действий 

          .Protection = msoBarNoCustomize + msoBarNoChangeVisible + msoBarNoMove 
          .Visible = True 
     End With 
End With

Application.CommandBars(3).Protection = msoBarNoCustomize

Application.CommandBars("Standard").Protection = msoBarNoCustomize

Application.CommandBars(3).Protection = msoBarNoProtection

Application.CommandBars("Standard").Protection = msoBarNoProtection

Dim iCommandBar As CommandBar 
For Each iCommandBar In Application.CommandBars 
    iCommandBar.Enabled = False 
Next

With Application.CommandBars 
     For iCount& = 1 To .Count 
         .Item(iCount&).Enabled = False 
     Next 
End With

Application.CommandBars(1).Reset 
Application.CommandBars("Worksheet Menu Bar").Reset

Application.CommandBars("Cell").Reset

With Application.CommandBars(1) 
     .Protection = msoBarNoProtection ' 
     With .Controls.Add(Type:=msoControlDropdown, Temporary:=True) 
          For Each iSheet In ActiveWorkbook.Sheets 
              .AddItem iSheet.Name 
              'метод .AddItem используется для заполнения поля со списком 
          Next 
          .OnAction = "Макрос1" 
          .Width = 200 'необязательно 
          .Caption = "Список всех листов :" 
          .Style = msoComboLabel 
     End With 
End With

With Application.CommandBars(1) 
     .Protection = msoBarNoProtection ' 
     With .Controls.Add(Type:=msoControlComboBox, Temporary:=True) 
          .AddItem "MS Excel" 
          .AddItem "MS Access" 
          .AddItem "MS Word" 
          .OnAction = "Макрос2" 
     End With 
End With

With Application.CommandBars.Add(Temporary:=True) _ 
     .Controls.Add(Type:=msoControlDropdown) 
     .DropDownWidth = -1 ' 
     For Each iControl In Application.CommandBars(8).Controls 
         .AddItem iControl.Caption 
     Next 
     With .Parent 
          .Position = msoBarBottom 
          .Protection = msoBarNoChangeVisible 
          .Visible = True 
     End With 
End With

Application.CommandBars(1).Controls.Add Type:=msoControlEdit, Temporary:=True

With Application.CommandBars(1) 
     .Protection = msoBarNoProtection ' 
     With .Controls.Add(Type:=msoControlEdit, Temporary:=True) 
          .Width = 200 
          .Caption = "Поле для ввода :" 
          .Style = msoButtonIcon 
          .Text = "Введите текст" 
          .OnAction = "Макрос3" 
     End With 
End With

With Application.CommandBars(4).Controls.Add(Type:=msoControlButton) 
     .Caption = "Золотой ключик" 
     .FaceId = 264 
     .OnAction = "Макрос" 
     .State = msoButtonDown 
End With

With Application.Toolbars(2).ToolbarButtons.Add(Button:=216) 
     .Name = "Золотой ключик" 
     .OnAction = "Макрос" 
     .Pushed = True 'только после присвоения макроса 
End With

Application.CommandBars(3).Controls(3).BeginGroup = True

Toolbars(1).ToolbarButtons.Add(Button:=0, Before:=2).Name = "-"