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. Как программно извлечь значок(иконку) у кнопки ? 31.08.2016
  8. Как программно создать кнопку на панели инструментов, которая будет действовать как гиперссылка ? 05.10.2007
  9. Как в рабочей книге заблокировать стандартные кнопки, команды и горячие клавиши, которые отвечают за копирование ? 23.02.2007
  10. Как в рабочей книге скрыть стандартные кнопки, которые отвечают за отправку книги по электронной почте ? 15.03.2011
  11. Как в рабочей книге "заблокировать" горячие клавиши, а также скрыть панели инструментов и команды, позволяющие перейти в редактор VBA ? 22.08.2016
  12. Как программно добавить/удалить закладку Разработчик на ленту ? 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-2018 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff