Microsoft Excel:

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


Rambler's Top100


Counter CO.KZ


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



    [1] [2]

  1. Как искать нужный элемент управления (контрол) в панелях инструментов ? 04.05.2014
  2. Как вывести все панели инструментов, в т.ч. контекстные меню, в виде отдельного списка ? 15.07.2007
  3. Как запретить вывод на экран контекстного меню, которое появляется после клика правой кнопкой мышки ? 09.09.2007
  4. Как программно определить какая из кнопок, расположенных на панели инструментов, вызвала макрос ? 26.09.2007
  5. Как программно определить назначен ли кнопке, в т.ч. и стандартной, макрос или нет ? 10.11.2010
  6. Как программно создать собственный значок для кнопки ? 10.11.2010
  7. Как программно извлечь значок(иконку) у кнопки ? NEW 31.08.2016
  8. Как программно создать кнопку на панели инструментов, которая будет действовать как гиперссылка ? 05.10.2007
  9. Как в рабочей книге заблокировать стандартные кнопки, команды и горячие клавиши, которые отвечают за копирование ? 23.02.2007
  10. Как в рабочей книге скрыть стандартные кнопки, которые отвечают за отправку книги по электронной почте ? 15.03.2011
  11. Как в рабочей книге "заблокировать" горячие клавиши, а также скрыть панели инструментов и команды, позволяющие перейти в редактор VBA ? NEW 22.08.2016
  12. Как программно добавить/удалить закладку Разработчик на ленту ? NEW 22.08.2016
    [1] [2]


  • Ответ :

    Вариант I. Актуально для MS Excel 95

    В этой версии, для поиска нужного элемента управления, приходится перебирать все контролы нужной панели инструментов. Далее приводится поиск кнопки "Открыть", расположенной на панели инструментов "Стандартная", с последующей блокировкой (в случае её нахождения)
  • Private Sub ToolbarButton_OpenFileEnabled()
        Dim iToolBar As Toolbar, iButton As ToolbarButton
        Set iToolBar = Toolbars(1) 'Toolbars("Стандартная")

        For Each iButton In iToolBar.ToolbarButtons
            If iButton.ID = 1 Then 'iButton.Name = "Открыть"
               iButton.Enabled = False
               Exit For
            End If
        Next
    End Sub
    Вариант II. Актуально для MS Excel 97 (и старше)

    В этой(и последующих) версиях, для поиска можно использовать метод FindControl, который возвращает об'ект CommandBarControl, разумеется, если искомый элемент управления был найден и Nothing, если нет.
    Private Sub Example_FindControl() 'XL97 (и старше)
        Dim iCommandBar As CommandBar
        Dim iControl As CommandBarControl

        'Set iCommandBar = Application.CommandBars(3)
        Set iCommandBar = Application.CommandBars("Standard")
        Set iControl = iCommandBar.FindControl(ID:=23)

        If Not iControl Is Nothing Then
           iControl.Enabled = True
           iControl.Execute
        Else
           MsgBox "Увы, ничего не найдено", , ""
        End If
    End Sub
    Обратите внимание на то, что поиск контрола можно осуществлять как в конкретной панели инструментов (см. выше), так и во всех панелях сразу, т.е. Application.CommandBars.FindControl, однако в обоих случаях, будет найден только один(самый первый) контрол. Если же искомых контролов может быть несколько, то имеет смысл воспользоваться следующим вариантом.

    Вариант III. Актуально для MS Excel 2000 (и старше)

    В этой версии, уже появился метод FindControls, который сразу ищет во всех панелях инструментов и в случае нахождения, возвращает об'ект CommandBarControls, т.е. все найденные элементы управления.
    Private Sub Example_FindControls() 'XL2000 (и старше)
        Dim iControl As CommandBarControl
        Dim iFindControls As CommandBarControls

        Set iFindControls = Application.CommandBars.FindControls(ID:=23)

        If Not iFindControls Is Nothing Then
           For Each iControl In iFindControls
               MsgBox "Контрол найден на панели " & iControl.Parent.NameLocal, , ""
           Next
        Else
           MsgBox "Увы, ничего не найдено", , ""
        End If
    End Sub
    Комментарий : при поиске также можно указывать тип (Type) искомого контрола и/или осуществлять поиск по тэгу (Tag), что может быть полезно, например, при поиске контролов, созданных программно. Если же Вам необходимо найти стандартные элементы управления по идентификационному номеру (ID), то рекомендую заглянуть на официальный сайт Microsoft (см. далее), ибо там наличествует список ID, вместе с именами контролов и панелей инструментов, на которых они расположены.

    XL97: List of ID Numbers for Built-In Command Bar Controls

    List of ID numbers for built-in CommandBar controls in Excel 2000
  • Ответ :

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

    Вариант I.
  • Private Sub CreateCommandBarsList()
         Application.ScreenUpdating = False
         Dim iCommandBar As CommandBar ''''
         For Each iCommandBar In Application.CommandBars
             iIndex& = iCommandBar.Index + 1
             Cells(iIndex&, 1) = iCommandBar.Name
             Cells(iIndex&, 2) = iCommandBar.NameLocal
             Cells(iIndex&, 3) = iCommandBar.Visible
             Cells(iIndex&, 4) = Not iCommandBar.Enabled
             Cells(iIndex&, 5) = Not iCommandBar.BuiltIn
             Cells(iIndex&, 6) = _
             CBool(iCommandBar.Protection And msoBarNoCustomize)
             Select Case iCommandBar.Type
                 Case msoBarTypeNormal:  iType$ = "Станд. панель инструментов"
                 Case msoBarTypePopup:   iType$ = "Контекстное меню"
                 Case msoBarTypeMenuBar: iType$ = "Строка меню"
             End Select
             Cells(iIndex&, 7) = iType$
         Next
         With Cells(1, 1).Resize(1, 7) 'Range("A1:G1")
              .Value = Array("Name", "NameLocal", "Visible", _
              "Enabled", "UserCommandBar", "Protection", "Type")
              .Font.Bold = True
              .EntireColumn.AutoFit
         End With
         Application.ScreenUpdating = True
    End Sub
    Вариант II.
    Private Sub CreateCommandBarsList2()
    Application.ScreenUpdating = False
    With Application.CommandBars
         For iCount& = 1 To .Count
             iRow& = iCount& + 1 '
             With .Item(iCount&)
                  Cells(iRow&, 1) = .Name
                  Cells(iRow&, 2) = .NameLocal
                  Cells(iRow&, 3) = .Visible
                  Cells(iRow&, 4) = Not .Enabled
                  Cells(iRow&, 5) = Not .BuiltIn
                  Cells(iRow&, 6) = _
                  CBool(.Protection And msoBarNoCustomize)
                  Select Case .Type
                      Case msoBarTypeNormal:  iType$ = "Станд. панель инструментов"
                      Case msoBarTypePopup:   iType$ = "Контекстное меню"
                      Case msoBarTypeMenuBar: iType$ = "Строка меню"
                  End Select
                  Cells(iRow&, 7) = iType$
             End With
         Next
    End With
    With Cells(1, 1).Resize(1, 7) 'Range("A1:G1")
         .Value = Array("Name", "NameLocal", "Visible", _
         "Enabled", "UserCommandBar", "Protection", "Type")
         .EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
    End Sub

  • Ответ :

    Для того, чтобы после выделении ячейки и клика правой кнопкой мышки, на экране не появлялось стандартное контекстное меню, достаточно скопировать весь нижеприведённый код в модуль нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
        Cancel = True
    End Sub
    Если же, это контекстное меню необходимо "заблокировать" только после клика правой кнопкой мышки в определённых ячейках(строках, столбцах) рабочего листа, то :
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
        If Not Intersect(Target, Me.Range("A2:B100,F1,H5")) Is Nothing Then Cancel = True
    End Sub
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
        Cancel = Not Intersect(Target, Me.Range("A2:B100,F1,H5")) Is Nothing
    End Sub
    А для того, чтобы "заблокировать" это контекстное меню во всех рабочих листах, достаточно всего лишь скопировать нижеприведённый код в модуль ThisWorkbook(ЭтаКнига)
    Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
        Cancel = True
    End Sub

  • Ответ : Скачать пример

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

    Вариант I. Для решения этой задачи можно воспользоваться свойством ActionControl об'екта CommandBars, например :
  • With Application.CommandBars.ActionControl
         MsgBox _
         "Контрол : " & .Caption & vbNewLine & _
         "Индекс(номер) : " & .Index, , ""
    End With
    Вариант II. Или свойством Caller об'екта Application, которое в случае с панелью инструментов, возвращает массив содержащий индекс(номер) и локальное имя панели инструментов :
    iInformation = Application.Caller
    iIndex& = iInformation(1)
    iTName$ = iInformation(2)
    With Toolbars(iTName$).ToolbarButtons(iIndex&)
         MsgBox _
         "Контрол : " & .Name & vbNewLine & _
         "Индекс(номер) : " & iIndex&, , ""
    End With
    Примечание : Следует учитывать, что при работе с меню, возвращается массив содержащий индекс команды, меню и строки меню.
  • Ответ :
  • With Application.CommandBars(3).Controls(1)
        If Not .BuiltIn Then
           MsgBox "Кнопке " & .Caption & _
           " назначен макрос :" & vbCrLf & .OnAction
        End If
    End With
    Комментарий : Настоятельно не рекомендуется использовать следующие варианты .OnAction <> "" или Len(.OnAction) > 0, так как их использование может привести к возникновению ошибки, ибо не всем контролам можно назначить макрос.

    Примечание :
  • - В качестве примера выбрана стандартная панель инструментов ("Стандартная") и первый контрол, как правило, это кнопка "Создать"
  • - Вместо номера/индекса панели Вы можете использовать её имя, и заменить (3) на ("Standard")
  • Ответ : Скачать пример

    Для того, чтобы программно создать собственный значок можно поместить необходимое изображение в буфер обмена (скопировать), а затем применить метод PasteFace

    Пример I. Если для создания значка нужно использовать данные и формат ячейки, то :
  • Worksheets("Лист1").Range("A1").CopyPicture

    Application.CommandBars("Standard").Controls.Add.PasteFace
    Worksheets(1).Cells(1).CopyPicture

    Toolbars(1).ToolbarButtons.Add(Button:=222, Before:=1).PasteFace
    Примечание : Качество полученного значка, как правило, зависит от высоты, ширины ячейки, шрифта и количества символов в ячейке. Правда, при необходимости, полученый значок можно отредактировать (более подробно ...)

    Пример II. Eсли же в качестве значка нужно использовать определённую картинку, то используйте следующий вариант (не забывайте, что копирование можно применить и к об'ектам других семейств, например, DrawingObjects, OLEObjects, Shapes, и т.д.) :
    Worksheets(1).Picture(1).Copy 'CopyPicture

    Application.CommandBars(3).Controls(1).PasteFace
    Worksheets("Лист1").Picture("Рисунок1").Copy 'CopyPicture

    Application.CommandBars("Standard").Controls("Кнопка1").PasteFace
    Примечание : Для того, чтобы значок был хорошего качества, он должен иметь те же размеры, что и стандартные значки, т.е. 16x16 пикселов, т.к. графические об'екты имеющие другие размеры, при вставке, будут искажены.

    Пример III. Eсли же для создания значка планируется использовать существующий графический файл, то в этом случае :
    With Worksheets(1).Pictures.Insert(FileName:="C:\Мои рисунки\Картинка.jpg")
        .Copy 'CopyPicture
        .Delete
    End With
    Application.CommandBars(1).Controls.Add.PasteFace
    Особенности Microsoft Excel XP

    В этой версии появилось новое свойство Picture, которое не без помощи функции LoadPicture() позволит создать значок, причём, без дополнительных действий, таких как, импорт графического файла, копирование и удаление уже ненужной картинки (см.пример3) :
    Application.CommandBars(1).Controls.Add.Picture = LoadPicture("C:\Мои рисунки\Картинка.jpg")
    Примечание :
  • - Для демонстрации были выбраны стандартные панели инструментов ("Стандартная") и ("Строка меню листа")
  • - В некоторых примерах предполагается создание новых кнопок, но это не является обязательным условием.
  • - При использовании этих примеров убедитесь, что панель инструментов не защищена [FAQ125], а графический файл реально существует [FAQ44]
  • Ответ : Скачать пример Актуально только для MS Excel XP-2003

    Для того, чтобы программно извлечь значок(иконку) у кнопки с панели инструментов, можно воспользоваться свойством Picture. А чтобы воспользоваться полученным изображением, можно использовать об'ект, который позволяет работать с stdole.StdPicture, например, это может быть другая кнопка с панели инструментов или ActiveX элемент управления (во всех примерах, это Рисунок(Image1))
  • Dim IPict As stdole.StdPicture
    Set IPict = Application.CommandBars.FindControl(ID:=22).Picture

    'Лист1.Image1.Picture = IPict
    UserForm1.Image1.Picture = IPict
    Особенности Microsoft Excel 2007

    В этой версии появился новый метод GetImageMso, который также позволяет получить нужное изображение.
    Dim IPictDisp As stdole.IPictureDisp
    Set IPictDisp = Application.CommandBars.GetImageMso("Paste", 16, 16)

    'Лист1.Image1.Picture = IPictDisp
    UserForm1.Image1.Picture = IPictDisp
    Примечание :
  • - Для демонстрации была выбрана кнопка "Вставить"
  • - Использование об'ектных переменных не носит обязательного характера. Проще говоря, если наглядность и читабельность не важна, то можно :
  • UserForm1.Image1.Picture = Application.CommandBars.FindControl(ID:=22).Picture

  • Ответ :

    Как программно создать кнопку, которая будет действовать как гиперссылка ? 28.03.2012
  • Ответ : Актуально только для MS Excel 97 Скачать пример

    Для того, чтобы в нужной рабочей книге "заблокировать" использование команд Вырезать, Копировать, Вставить, Специальная вставка и Формат по образцу, а также горячих клавиш CTRL+X, CTRL+C, CTRL+V скопируйте нижеприведённый код в модуль ThisWorkbook(ЭтаКнига) нужной рабочей книги.
  • Private Sub Workbook_Activate()
        ChangeEnvironment
    End Sub

    Private Sub Workbook_Deactivate()
        RestoreEnvironment
    End Sub

    Private Sub ChangeEnvironment()

    Dim iCommandBar As CommandBar
    Dim iFindControl As CommandBarButton

    With Application
         .OnKey Key:="^x", Procedure:="No_Copy" ' ""
         .OnKey Key:="^c", Procedure:="No_Copy" ' ""
         .OnKey Key:="^v", Procedure:="No_Copy" ' ""
         .CellDragAndDrop = False 'Снятие опции перетаскивать ячейки
         For Each iControlID In Array(19, 21, 22, 108, 369, 370, 755)
             For Each iCommandBar In .CommandBars
                 Set iFindControl = iCommandBar.FindControl _
                 (Id:=iControlID, Visible:=False, Recursive:=True)
                 If Not iFindControl Is Nothing Then
                     iFindControl.OnAction = "No_Copy"
                     If (iCommandBar.Protection And msoBarNoCustomize) = 0 Then _
                     iCommandBar.Protection = msoBarNoCustomize
                 End If
             Next
         Next
    End With

    End Sub

    Private Sub RestoreEnvironment()

    Dim iCommandBar As CommandBar
    Dim iFindControl As CommandBarButton

    With Application
         .OnKey Key:="^x": .OnKey Key:="^c": .OnKey Key:="^v"
         .CellDragAndDrop = True 'Установка опции перетаскивать ячейки
         For Each iControlID In Array(19, 21, 22, 108, 369, 370, 755)
             For Each iCommandBar In .CommandBars
                 Set iFindControl = iCommandBar.FindControl _
                 (Id:=iControlID, Visible:=False, Recursive:=True)
                 If Not iFindControl Is Nothing Then
                     iFindControl.Reset
                     If (iCommandBar.Protection And msoBarNoCustomize) <> 0 Then _
                     iCommandBar.Protection = msoBarNoProtection
                 End If
             Next
         Next
    End With

    End Sub

    Private Sub No_Copy(): End Sub 'В любом стандартном модуле
    В принципе тоже самое, только во второй версии передача аргументов осуществляется по позиции, а не по имени, как в первом случае, кроме того здесь не используется метод Reset об'екта CommandBarButton, увеличивается количество обращений к об'екту Application и нет проверок - защищена или нет панель инструментов, на которой находится найденная кнопка, последнее, естественно, приводит к тому, что мы лишний раз мучаем об'ект CommandBar (т.е., к примеру, 'защищаем' об'ект CommandBar у которого значение свойства и так msoBarNoCustomize)
    Private Sub Workbook_Activate()
        DisabledCopyPaste msoBarNoCustomize
    End Sub

    Private Sub Workbook_Deactivate()
        DisabledCopyPaste msoBarNoProtection, ""
    End Sub

    Private Sub DisabledCopyPaste(iProtection%, Optional iMacros$ = "No_Copy")
        Dim iCommandBar As CommandBar
        Dim iFindControl As CommandBarButton

        If iProtection = msoBarNoCustomize Then
           Application.OnKey "^x", iMacros
           Application.OnKey "^c", iMacros
           Application.OnKey "^v", iMacros
        Else
           Application.OnKey Key:="^x"
           Application.OnKey Key:="^c"
           Application.OnKey Key:="^v"
        End If
        Application.CellDragAndDrop = Not CBool(iProtection)

        For Each iControlID In Array(19, 21, 22, 108, 369, 370, 755)
            For Each iCommandBar In Application.CommandBars
                Set iFindControl = iCommandBar.FindControl(, iControlID, , False, True)
                If Not iFindControl Is Nothing Then
                    iFindControl.OnAction = iMacros
                    iCommandBar.Protection = iProtection
                End If
            Next
        Next
    End Sub

    Private Sub No_Copy(): End Sub 'В любом стандартном модуле
    Комментарий : Данный пример нельзя использовать в MS Excel 95, т.к. там отсутствует семейство CommandBars, и он неактуален для применения в MS Excel 2000, XP по причине появления в этих версиях буфера обмена.
  • Ответ : Актуально только для MS Excel 2000, XP, 2003 Скачать пример

    Для того, чтобы в нужной рабочей книге "заблокировать" использование команд, которые позволяют отправить эту книгу по электронной почте, скопируйте нижеприведённый код в модуль ThisWorkbook(ЭтаКнига) нужной рабочей книги (при необходимости перечень, содержащий ID команд, отвечающих за отправку сообщений, можно увеличить)
  • Private Sub Workbook_Activate()
        HiddenControls False, msoBarNoCustomize
    End Sub

    Private Sub Workbook_Deactivate
        HiddenControls True, msoBarNoProtection
    End Sub

    Private Sub HiddenControls(ControlVisible As Boolean, BarProtection%)
        Dim iControl As CommandBarControl
        Dim iControls As CommandBarControls

        '2188 "Соо&бщение (как вложение)..."
        '3708 "&Отправить"
        '3738 "&Сообщение"
        '30095 "&Отправить" ' CommandBars("Send To")

        For Each iControlID In Array(2188, 3708, 3738)
            Set iControls = Application.CommandBars.FindControls(ID:=iControlID)
            If Not iControls Is Nothing Then
               For Each iControl In iControls
                   iControl.Visible = ControlVisible '.Enabled
                   iControl.Parent.Protection = BarProtection '
               Next
            End If
        Next
        Application.CommandBars(1).Protection = BarProtection
    End Sub
    Совет : Если подобный финт нужно применить ко всем рабочим книгам, то замените события Workbook_Activate, Workbook_Deactivate на события Workbook_Open, Workbook_BeforeClose и расположите их, например, в модуле ThisWorkbook(ЭтаКнига) личной книги макросов "Personal.xls"
  • Ответ : Актуально только для MS Excel 2000, XP, 2003

    Для того, чтобы после открытия рабочей книги, "заблокировать" горячие клавиши, а также скрыть панели инструментов и команды, позволяющие перейти в редактор VBA, скопируйте весь нижеприведённый код в модуль ThisWorkbook(ЭтаКнига) нужной рабочей книги.
  • '**************************************************************'
    '    Процедура предназначена для того, чтобы "заблокировать"   '
    '    горячие клавиши и скрыть панели инструментов и команды,   '
    '    позволяющие перейти в редактор VBA                        '
    '                                                              '
    '    Версия Excel : 2000, XP, 2003                             '
    '                                                              '
    '    Автор Климов Павел Юрьевич                                '
    '    http://www.msoffice-nm.ru (http://www.msoffice.nm.ru)     '
    '**************************************************************'
    
    Private Sub Workbook_Open() 'Microsoft Excel 2000, XP, 2003
        Application.OnKey "%{F8}", ""
        Application.OnKey "%{F11}", ""
        EnabledEditorVBA False, msoBarNoCustomize
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
        Application.OnKey "%{F8}"
        Application.OnKey "%{F11}"
        EnabledEditorVBA True, msoBarNoProtection
    End Sub
    
    Private Sub EnabledEditorVBA(prValue As Boolean, cbarProtect%)
        Dim iControl As CommandBarControl
        Dim iControls As CommandBarControls
    
        '859   "Назначит&ь макрос..."
        '1561  "Ис&ходный текст"
        '30017 "&Макрос"
    
        For Each ID In Array(859, 1561, 30017)
            Set iControls = Application.CommandBars.FindControls(, ID)
            If Not iControls Is Nothing Then
               For Each iControl In iControls
                   iControl.Visible = prValue '.Enabled =
                   iControl.Parent.Protection = cbarProtect
               Next
            End If
        Next
    
        Application.CommandBars("Visual Basic").Enabled = prValue
        Application.CommandBars("Control Toolbox").Enabled = prValue
        Application.CommandBars("Forms").Enabled = prValue
    End Sub
    Особенности Microsoft Excel 2007

    В данной версии этот совет не особо актуален, по причине появления на ленте отдельной вкладки Разработчик, которая позволяет перейти в редактор VBA. Правда данную вкладку можно и убрать, но её легко вернуть обратно, причём, для этого даже не придётся использовать макрос.
  • Ответ : Актуально только для MS Excel 2007

    Для того, чтобы программно добавить на ленту вкладку Разработчик, достаточно выполнить следующую инструкцию
  • Application.ShowDevTools = True
    А чтобы избавиться от вкладки Разработчик
    Application.ShowDevTools = False

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

    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff