Главная страница
Навигация по странице:

  • Листинг 3.90.

  • Листинг 3.91.

  • Готовые макросы в VBA Excel (Миронов.) (z-lib.org). Запуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6


    Скачать 1.47 Mb.
    НазваниеЗапуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6
    Дата26.06.2022
    Размер1.47 Mb.
    Формат файлаdoc
    Имя файлаГотовые макросы в VBA Excel (Миронов.) (z-lib.org).doc
    ТипДокументы
    #615298
    страница29 из 47
    1   ...   25   26   27   28   29   30   31   32   ...   47

    Создание пользовательского меню (вариант 6)


    Sub CreateMenu()

    Dim cbrMenu As CommandBar

    Dim cbrcNewMenu As CommandBarControl

    ' Удаление меню, если оно уже есть

    Call DeleteMenu

    ' Добавление строки пользовательского меню

    Set cbrMenu = CommandBars.Add(MenuBar:=True)

    With cbrMenu

    .Name = "Моя строка меню"

    .Visible = True

    End With

    ' Копирование стандартного меню "Файл"

    CommandBars("Worksheet Menu Bar").FindControl(ID:=30002).Copy _

    CommandBars("Моя строка меню")

    ' Добавление нового меню - "Дополнительно"

    Set cbrcNewMenu = cbrMenu.Controls.Add(msoControlPopup)

    cbrcNewMenu.Caption = "&Дополнительно"

    ' Добавление команды в новое меню

    With cbrcNewMenu.Controls.Add(msoControlButton)

    .Caption = "&Восстановить обычную строку меню"

    .OnAction = "DeleteMenu"

    End With

    ' Добавление команды в новое меню

    With cbrcNewMenu.Controls.Add(Type:=msoControlButton)

    .Caption = "&Справка"

    End With

    End Sub

    Sub DeleteMenu()

    ' Пытаемся удалить меню (успешно, если оно ранее создано)

    On Error Resume Next

    CommandBars("Моя строка меню").Delete

    On Error GoTo 0

    End Sub

    Список панелей инструментов и контекстных меню

    Sub ListOfMenues()

    Dim intRow As Integer ' Хранит текущую строку

    Dim cbrBar As CommandBar

    ' Очистка всех ячеек текущего листа

    Cells.Clear

    intRow = 1 ' Начинаем запись с первой строки

    ' Просматриваем список панелей инструментов и меню _

    и записываем информацию о каждом элементе в таблицу

    For Each cbrBar In CommandBars

    ' Порядковый номер

    Cells(intRow, 1) = cbrBar.Index

    ' Название

    Cells(intRow, 2) = cbrBar.Name

    ' Тип

    Select Case cbrBar.Type

    Case msoBarTypeNormal

    Cells(intRow, 3) = "Панель инструментов"

    Case msoBarTypeMenuBar

    Cells(intRow, 3) = "Строка меню"

    Case msoBarTypePopup

    Cells(intRow, 3) = "Контекстное меню"

    End Select

    ' Встроенный элемент или созданный пользователем

    Cells(intRow, 4) = cbrBar.BuiltIn

    ' Переходим на следующую строку

    intRow = intRow + 1

    Next

    End Sub

    Создание списка пунктов главного меню Excel


    Листинг 3.90. Список содержимого главного меню

    Sub ListOfMenues()

    Dim intRow As Integer ' Текущая строка, куда идет запись

    Dim cbrcMenu As CommandBarControl ' Главное меню

    Dim cbrcSubMenu As CommandBarControl ' Подменю

    Dim cbrcSubSubMenu As CommandBarControl ' Подменю в подменю

    ' Очищаем ячейки текущего листа

    Cells.Clear

    ' Начинаем запись с первой строки

    intRow = 1

    ' Просматриваем все элементы строки меню

    On Error Resume Next ' Игнорируем ошибки

    For Each cbrcMenu In CommandBars(1).Controls

    ' Просматриваем элементы выпадающего меню cbrcMenu

    For Each cbrcSubMenu In cbrcMenu.Controls

    ' Просматриваем элементы подменю cbrcSubMenu

    For Each cbrcSubSubMenu In cbrcSubMenu.Controls

    ' Выводим название главного меню

    Cells(intRow, 1) = cbrcMenu.Caption

    ' Выводим название подменю

    Cells(intRow, 2) = cbrcSubMenu.Caption

    ' Выводим название вложенного подменю

    Cells(intRow, 3) = cbrcSubSubMenu.Caption

    ' Переходим на следующую строку

    intRow = intRow + 1

    Next cbrcSubSubMenu

    Next cbrcSubMenu

    Next cbrcMenu

    End Sub

    Создание списка пунктов контекстных меню


    Листинг 3.91. Список содержимого контекстных меню

    Sub ListOfContextMenues()

    Dim intRow As Long

    Dim intControl As Integer

    Dim cbrBar As CommandBar

    ' Очистка ячеек активного листа

    Cells.Clear

    ' Начинаем вывод с первой строки

    intRow = 1

    ' Просмотр списка контекстных меню и вывод информации о них

    For Each cbrBar In CommandBars

    If cbrBar.Type = msoBarTypePopup Then

    ' Порядковый номер

    Cells(intRow, 1) = cbrBar.Index

    ' Название

    Cells(intRow, 2) = cbrBar.Name

    ' Просмотр всех элементов контекстного меню и вывод _

    названий этих элементов в ячейки текущей строки

    For intControl = 1 To cbrBar.Controls.Count

    Cells(intRow, intControl + 2) = _

    cbrBar.Controls(intControl).Caption

    Next intControl

    ' Переход на следующую строку таблицы

    intRow = intRow + 1

    End If

    Next cbrBar

    ' Делаем ширину ячеек таблицы оптимальной для просмотра

    Cells.EntireColumn.AutoFit

    End Sub
    1   ...   25   26   27   28   29   30   31   32   ...   47


    написать администратору сайта