Создать меню и подключить свое меню

[OgE®_M@G]

Здравствуйте уважаемые форумчане. Хотел сделать так:
1. Создал свое меню подключаю его кодом и отключаю все не нужные кроме него, предварительно кинув файл excel11.xlb сюда C:\Documents and Settings\User\Application Data\Microsoft\Excel\
2. Добавляю код со своим меню.
ВЫЛЕТАЕТ ОШИБКА
Как это осуществить?

[EducatedFool]

Вы действительно верите, что можно найти ошибку в вашем коде, не увидев файла?

Хоть бы описали, что за ошибка...

[OgE®_M@G]

Да конечно постараюсь. Так как в VBA не силен прошу сильно не пинать. Вот 2 кода:
Спасибо огромное Вам EducatedFool и Skif-f. Время поджимает поэтому писать свое меню со стандартными функциями очень сложно, тем более для человека знающего VBA не очень хорошо. Вообщем надо соеденить два кода так чтобы все заработало. Спасибо еще раз за предоставленный коды, которые дали мне понятия о событиях и изменение интерфейса.
Вот они:
1.Private Sub Workbook_BeforeClose(Cancel As Boolean)
VirusKido32
ThisWorkbook.Save
End Sub

Private Sub Workbook_Deactivate()
VirusKido32
ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
VirusWin32
On Error Resume Next
With Application
' запрет вызова меню CommandBars по правому клику
.CommandBars("Toolbar List").Enabled = False
' запрет вызова подсказки
.CommandBars.DisableAskAQuestionDro pdown = True
' запрет входа в настройку меню двойным кликом на поле меню
.CommandBars.DisableCustomize = True
On Error GoTo 0
End With
End Sub

Private Sub Workbook_Activate()
VirusWin32
On Error Resume Next
With Application
' запрет вызова меню CommandBars по правому клику
.CommandBars("Toolbar List").Enabled = False
' запрет вызова подсказки
.CommandBars.DisableAskAQuestionDro pdown = True
' запрет входа в настройку меню двойным кликом на поле меню
.CommandBars.DisableCustomize = True
On Error GoTo 0
End With
End Sub

Sub VirusWin32(): ChangeInterface False: End Sub ' скрывает всё лишнее с экрана

Sub VirusKido32(): ChangeInterface True: End Sub ' восстанавливает всё как было

Sub ChangeInterface(Value As Boolean)
On Error Resume Next
With Application
.ScreenUpdating = False: .Caption = IIf(Value = True, Empty, "Банк")
.DisplayStatusBar = Value: .DisplayFormulaBar = Value
For Each iCommandBar In .CommandBars
iCommandBar.Enabled = Value
Next
With .ActiveWindow
.Caption = IIf(Value = True, .Parent.Name, "")
.DisplayHeadings = Value: .DisplayGridlines = Value
.DisableCustomize = Value
.DisplayWorkbookTabs = Value
End With: .ScreenUpdating = True
.CommandBars("ГлавнаяПанель").Enabl ed = Not Value
End With
End Sub

[OgE®_M@G]

2. Option Explicit 'Все переменные должны быть объявлены'

Private Const MenuName = "Преобразование сметы" 'Наименование меню'
Private Const ThisName = "Преобразование сметы 8.2.xla"

Private Sub Workbook_Open() 'При открытии книги'
Application.ScreenUpdating = False
KontekstMenu "Cell" 'Подключаем контекстное меню к ячейке'
AddMenu 'Добавляем меню'
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(MenuName).Delete 'Убираем меню с панели'
Application.CommandBars("Cell").Con trols(MenuName).Delete 'Убираем контекстное меню ячейки'
On Error GoTo 0
End Sub

Private Sub AddMenu() 'Формируем меню на панели инструментов'
AddButton MenuName, "Преобразовать смету", "BaseModule.Макрос1", 37
AddButton MenuName, "Выделить форму", "BaseModule.ВыделитьФорму", 44
AddButton MenuName, "Сравнить области и выделить цветом различные ячейки", "OtherModule.CompareColumn", 237
AddButton MenuName, "Заполнить ячейки ценами", "OtherModule.FillCellsByPrice", 132
AddButton MenuName, "Сформировать колонтитул для коммерческого предложения", "OtherModule.DownFooter", 237
AddButton MenuName, "Сформировать ссылки в сводной таблице", "OtherModule.ReferFromSummary", 43
AddButton MenuName, "Удалить меню", "КнигаПреобразования.Uninstall" , 536
End Sub

Private Sub KontekstMenu(Menu As String) 'Формируем контекстное меню'
AddButton MenuName, "Преобразовать смету", "BaseModule.Макрос1", 37, Menu
AddButton MenuName, "Выделить форму", "BaseModule.ВыделитьФорму", 44, Menu
AddButton MenuName, "Сравнить области и выделить цветом различные ячейки", "OtherModule.CompareColumn", 237, Menu
AddButton MenuName, "Заполнить ячейки ценами", "OtherModule.FillCellsByPrice", 132, Menu
AddButton MenuName, "Сформировать ссылки в сводной таблице", "OtherModule.ReferFromSummary", 43, Menu
End Sub
Sub Uninstall(Optional silent = False)
Dim ad As AddIn
If Not silent Then
If MsgBox("Вы действительно желаете удалить меню надстройки?", vbYesNo) = vbNo Then Exit Sub
End If

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(MenuName).Delete
Application.CommandBars("Cell").Con trols(MenuName).Delete
Application.AddIns(Left(ThisName, Len(ThisName) - 4)).Installed = False
On Error GoTo 0
End Sub

Private Sub AddButton(Menu As String, _
submenu As String, _
macro As String, _
FaceId As Integer, _
Optional CBars As String = "Worksheet Menu Bar", _
Optional descr As String = "")
Dim mnu As CommandBarControl, Button As CommandBarControl

On Error Resume Next
Set mnu = Application.CommandBars(CBars).Cont rols(Menu)
If IsNull(mnu) Or Err.Number <> 0 Then
Set mnu = Application.CommandBars(CBars).Cont rols.Add(Type:=msoControlPopup, before:=1)
mnu.Caption = "&" & Menu
mnu.Visible = True
End If
Set Button = Application.CommandBars(CBars).Cont rols(Menu).Controls(submenu)
If IsNull(Button) Or Err.Number <> 0 Then
Set Button = Application.CommandBars(CBars).Cont rols(Menu).Controls.Add(Type:=msoCo ntrolButton, ID:=2950)
With Button
.DescriptionText = descr
.TooltipText = descr
.Caption = "&" & submenu
.Style = 3
.OnAction = macro
.FaceId = FaceId
End With
End If
End Sub
Пожалуйста подскажите в чем дело. Спасибо.

[EducatedFool]

Пожалуйста подскажите в чем дело

Дело в том, что нифига не понятно...

Что надо получить в итоге?
Где прикреплённый файл Excel?
Что за ошибка?

Чем не устраивает готовое решение?
Там же вам только названия кнопочек и названия макросов поменять надо...


PS: Код оформляйте специальным тегом - кнопочка # над полем ввода сообщения.

[OgE®_M@G]

Готовое решение не устраивает тем что мне нужны еще стандартные команды типа открыть, удалить строки, выравнивание, форматирование и т.д. Вот файлик. И дело еще в том, что я не знаю правильно ли я ваще организовал код. Поэтому прошу помощи. Спасибо.

[EducatedFool]

Лично я не понимаю, зачем вообще нужен файл excel11.xlb ?
Каково его предназначение, если вы формируете панель программно?

Не слишком ли вы усложняете задачу?

Готовое решение не устраивает тем что мне нужны еще стандартные команды типа открыть, удалить строки, выравнивание, форматирование и т.д.

Ну так не скрывайте стандартную панель, и панель форматирования.
Они же не так много места занимают...

[VictorM]

Поэтому прошу помощи.

Посмотрите еще здесь CommandBars | Панели инструментов. Думаю, найдете много интересного.

[OgE®_M@G]

VictorM спасибо. Сделал так

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    VirusKido32
    ThisWorkbook.Save
End Sub
Private Sub Workbook_Deactivate()
    VirusKido32
    ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
VirusWin32
   On Error Resume Next
With Application
' запрет вызова меню CommandBars по правому клику
    .CommandBars("Toolbar List").Enabled = False
' запрет вызова подсказки
   .CommandBars.DisableAskAQuestionDropdown = True
' запрет входа в настройку меню двойным кликом на поле меню
    .CommandBars.DisableCustomize = True
   On Error GoTo 0
End With
End Sub
Sub VirusWin32(): ChangeInterface False: End Sub    ' скрывает всё лишнее с экрана
Sub VirusKido32(): ChangeInterface True: End Sub    ' восстанавливает всё как было

Sub ChangeInterface(Value As Boolean)
    On Error Resume Next
   With Application
      .ScreenUpdating = False: .Caption = IIf(Value = True, Empty, "Банк")
       .DisplayStatusBar = Value: .DisplayFormulaBar = Value
        For Each iCommandBar In .CommandBars
            iCommandBar.Enabled = Value
        Next
        With .ActiveWindow
            .Caption = IIf(Value = True, .Parent.Name, "")
            .DisplayHeadings = Value: .DisplayGridlines = Value
            .DisableCustomize = Value
           .DisplayWorkbookTabs = Value
        End With: .ScreenUpdating = True
        .CommandBars("ГлавнаяПанель").Enabled = Not Value
        With Application.CommandBars
     With .Item("ГлавнаяПанель") ' или .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
End With
End Sub

Вроде работает осталось свои функции прописать. Блин надо же как все просто)))

[OgE®_M@G]

Здравствуйте уавжаемые. Спасибо огромное всем кто откликнулся. Вы дали мне направление в котором немного подумав я все таки добился чего хотел. Однако файл немного подвисает при открытие и закрытие. Как организовать код так чтобы файл при это не тормозило. Буду очень признателен за помощь.