Excel | FAQ | Макросы (VBA) | Панели инструментов [1]

Microsoft Excel:

Таблицы и VBA. Справочник.
Вопросы и Ответы. Советы. Примеры.

Меню FAQ | Макросы | CommandBars

Предисловие : Семейство CommandBars появилось только в MS Excel 97, поэтому, в MS Excel 95 необходимо использовать варианты, где используются Toolbars, MenuBars, ShortcutMenus.

[1] [2]

Как добавить свои элементы управления в стандартную панель инструментов ? 03.07.2005
Как добавить свои команды в стандартное контекстное меню ? 04.06.2006
Как модифицировать некоторые стандартные контекстные меню ? 01.05.2007
Как добавить своё собственное меню ? 03.07.2005
Как создать своё собственное контекстное меню ? 08.07.2007
Как отобразить стандартное или собственное контекстное меню, а также управлять его месторасположением на экране ? 30.07.2009
Как создать элемент управления так, чтобы отображался значок и текст одновременно ? 26.06.2005
Как отобразить надписи горизонтально в панели инструментов, расположенной слева / справа ? 29.06.2005
Kак создать контекстное меню для элементов управления ActiveX ? 01.03.2007
Как проверить является ли панель инструментов - контекстным меню ? 10.03.2007
Как расположить созданую панель инструментов сразу после стандартной, а также, сделать невозможным её скрытие, изменение и перемещение, вручную ? 10.01.2007
Как защитить панель инструментов от изменений ? 20.08.2006
Как защитить отдельное меню, т.е. запретить добавление новых и удаление, а также переименование уже существующих команд, вручную ? 12.02.2007
Как в рабочей книге заблокировать стандартные кнопки, команды и горячие клавиши, которые отвечают за копирование ? 23.02.2007
Как убрать все панели инструментов и заблокировать все контекстные меню ? 02.07.2007
Как восстановить первоначальное состояние панели инструментов ? 12.04.2009
Как создать контрол : раскрывающийся список на панели инструментов ? 28.12.2006
Как установить ширину раскрывающегося списка исходя из длины наибольшего элемента списка ? 16.04.2007
Как установить нужную ширину и количество элементов в раскрывающемся списке ? 10.05.2009
Как создать контрол : поле для ввода на панели инструментов ? 28.12.2006
Как создать поле для ввода, которое, по мере ввода символов, будет выдавать список имён файлов, папок и/или URL адресов, начинающихся с введённых символов ? 08.04.2011
Как создать кнопку на панели инструментов в "утопленном" состоянии ? 01.01.2007
Как создать разделительную полосу между контролами на панели инструментов ? 02.07.2007
[1] [2]

Ответ :

Вариант I.

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

Вариант II.

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

Примечание :

- В качестве примера выбрана стандартная панель инструментов ("Стандартная")

- Вместо номера/индекса панели Вы можете использовать её имя, например, заменить (3) на ("Standard"), а (1) на ("Стандартная")

- При использовании первого примера убедитесь, что панель инструментов не защищена [FAQ125]

- В данных примерах используются не все аргументы, свойства и методы.

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

Ответ :

Два примера добавления (в нужной рабочей книге) команды в контекстное меню "Ячейка", которое отображается при клике правой кнопки мышки в ячейке рабочего листа. Опубликованный код необходимо скопировать только в модуль

ThisWorkbook(ЭтаКнига) нужной рабочей книги.

Вариант I.

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

Вариант II.

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

Комментарий : В MS Excel 95 нет событий, в т.ч. и Workbook_Activate, Workbook_Deactivate, но пользователи этой версии могут использовать свойство OnWindow об'екта Application

Два примера добавления команды в контекстное меню "Лист", которое отображается при клике правой кнопки мышки в ярлычке рабочего листа. Код желательно скопировать в стандартный модуль личной книги макросов "Personal.xls"

Вариант I.

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

Вариант II.

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

Примечание :

- Использование свойства Protection не носит обязательного характера, но имеет смысл, если контекстное меню могло быть предварительно защищено от изменений .Protection = msoBarNoCustomize

- Все контекстные меню выбраны исключительно в качестве примера

- Вместо имени панели Вы можете использовать её номер/индекс

Ответ :

Для того, чтобы добавить стандартные команды Вставить формат и Вставить значения, которые обычно используются при Специальной вставке, в контекстное меню "Ячейка", которое отображается при клике правой кнопки мышки в ячейке рабочего листа, достаточно выполнить всего один раз данный макрос.

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

В MS Excel есть способ, позволяющий быстро получить необходимый результат вычислений для выделенного диапазона ячеек. Однако, этот способ имеет свои особенности, например, результат вычислений будет доступен, только при выделении диапазона, состоящего из более чем одной заполненной ячейки. Кроме того, данные, хранящиеся в ячейках скрытых строк, не будут участвовать в вычислении.
Если подобный расклад Вас не устраивает, то ниже опубликован авторский вариант, который позволяет обойти эти ограничения.
Для того, чтобы воспользоваться новыми возможностями скопируйте оба макроса и расположите их в любом стандартном модуле личной книги макросов "Personal.xls", после чего сохраните все изменения. Теперь, при следущем запуске приложения, Вам достаточно будет подвести курсор мышки к строке состояния, кликнить правую кнопку мышки и в появившемся контекстном меню

выбрать нужную команду.

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

Вариант I.

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

Вариант II.

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

Комментарий :

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

Обратите внимание на то, что в данном примере добавлена принципиально новая возможность, а именно подсчёт всех символов выделенных ячеек.

При подсчёте всех символов нельзя выделять несмежные ячейки/диапазоны, а также весь столбец целиком, однако, Вы можете выделить большую часть ячеек, например, "A1:A65535" Кроме того, незначительное изменение кода, позволит получить искомое количество символов всех несмежных ячеек/диапазонов.

Примечание :

- Использование свойств Enabled и Protection не носит обязательного характера, но имеет смысл, если контекстное меню могло быть предварительно заблокировано .Enabled = False и/или если меню могло быть защищено от изменений .Protection = msoBarNoCustomize

- Использование метода Reset (восстановление первоначального состояния контекстного меню) также необязательно

- Вместо имени панели Вы можете использовать её номер/индекс

Ответ :

Вариант I.

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

Вариант II (а)

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

Вариант II (б)

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

Примечание :

- В качестве примера выбрана стандартная панель инструментов ("Строка меню листа")

- Вместо номера/индекса панели Вы можете использовать её имя, например, заменить (1) на ("Worksheet Menu Bar")

- Или заменить имя ("Worksheet) на константу (xlWorksheet)

Ответ :

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

Ответ :

Отобразить контекстное меню (собственное, т.е. созданное программно [FAQ311], или стандартное) можно использовав его имя или индекс в семействе CommandBars, и метод ShowPopup об'екта CommandBar, который имеет два необязательных аргумента X, Y с помощью которых, Вы можете задать нужные координаты меню на экране :

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

Ответ : ^{Актуально только для MS Excel 2000 и старше}

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

Примечание :

- Панель инструментов с номером/индексом (3) и именем ("Cell") использована только в качестве примера.

Ответ :

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

Вернуть всё обратно можно установив значение свойства Protection как msoBarNoProtection :

Application.CommandBars(3).Protection = msoBarNoProtection

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

Примечание :

- В качестве примера выбрана стандартная панель инструментов ("Стандартная")

Ответ :

Application.CommandBars(1).Controls(1).CommandBar.Protection = msoBarNoCustomize

Application.CommandBars("Worksheet Menu Bar").Controls("Файл").CommandBar.Protection = msoBarNoCustomize

Примечание :

- В качестве примера выбрано меню ("Файл") которое располагается на стандартной панели инструментов ("Строка меню листа")

- Аналогичным образом можно защитить и собственное меню, т.е. меню созданное вручную или программно

- Для защиты самого меню необходимо защитить панель инструментов [FAQ125]

Ответ :

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

Вернуть всё обратно, можно просто установив значение свойства Enabled как True

Ответ :

Для того, чтобы восстановить первоначальное состояние панели инструментов, в т.ч. и контекстного меню, достаточно всего лишь использовать метод Reset об'екта CommandBar

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

Комментарий :

Элемент управления msoControlComboBox отличается от аналогичного элемента msoControlDropdown тем, что позволяет не только выбирать нужные элементы, но и вводить данные, не являющиеся элементами списка.

Примечание :

- Добавление надписи и изменение ширины возможно и для контрола msoControlComboBox

- В качестве примера выбрана стандартная панель инструментов ("Строка меню листа")

- Вместо номера/индекса панели Вы можете использовать её имя, например, заменить (1) на ("Worksheet Menu Bar")

Ответ :

При создании этого элемента управления - установите значение свойства DropDownWidth = -1

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

Ответ :

Если Вам потребуется изменить ширину выпадающего списка, то для этого существует свойство DropDownWidth, а "ограничить" количество элементов в выпадающем списке, можно с помощью свойства DropDownLines

Ответ :

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

Ответ :

Вариант I.

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

Вариант II.

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

Вернуть кнопке первоначальное состояние, можно установив значения свойств State и Pushed как msoButtonUp и False.

Примечание :

- В качестве примера выбрана стандартная панель инструментов ("Форматирование")

- Вместо номера/индекса панели Вы можете использовать её имя, например, заменить (4) на ("Formatting"), а (2) на ("Форматирование")

- При использовании первого примера убедитесь, что панель инструментов не защищена [FAQ125]

Ответ :

Вариант I.

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

Вариант II.

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

Примечание :

- В качестве примера выбрана стандартная панель инструментов ("Стандартная")

Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

WebDesign & Error's Klimoff

Microsoft Excel:

Таблицы и VBA. Справочник. Вопросы и Ответы. Советы. Примеры.

Таблицы и VBA. Справочник.
Вопросы и Ответы. Советы. Примеры.