Создание меню для просмотра встроенных в Excel значков панелей инструментов

Меню "Значки" - отображение иконок Excel, и их значений FaceID

Данный код формирует выпадающее меню "Значки" на стандартной панели инструментов:

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

Sub CreateMenuFaceID()
    ' создание меню ЗНАЧКИ с образцами кнопок панели инструментов
    Dim NewMenu As CommandBarPopup, MenuItem As CommandBarControl, Submenuitem As CommandBarButton
    Call DeleteMenuFaceID
    Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, Temporary:=True)
    NewMenu.Caption = "Значки": maxCount = 40: maxGroup = 8: N = maxGroup * maxCount
    For j = 0 To 20
        Set MenuItem = NewMenu.Controls.Add(Type:=msoControlPopup)
        With MenuItem: .Caption = j * N + 1 & " - " & (j + 1) * N: .BeginGroup = True:: End With
 
        For i = 0 To maxGroup - 1
            Set MenuItem2 = MenuItem.Controls.Add(Type:=msoControlPopup)
            With MenuItem2: .Caption = 1 + j * N + maxCount * i & " - " & j * N + maxCount * (i + 1): End With
            For ii = j * N + 1 + maxCount * i To j * N + maxCount * (i + 1)
                Set Submenuitem = MenuItem2.Controls.Add(Type:=msoControlButton): DoEvents
                With Submenuitem: .Caption = "FaceId = " & ii: .FaceID = ii: End With
            Next ii
        Next i
    Next j
End Sub
 
Sub DeleteMenuFaceID(): On Error Resume Next
    ' удаление меню ЗНАЧКИ с образцами кнопок панели инструментов
    Dim cbc As CommandBarControl
    For Each cbc In CommandBars(1).Controls
        If cbc.Caption = "Значки" Then cbc.Delete
    Next:
End Sub

Вложения:
FaceID.xls29.5 КБ

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Вот макросы попроще и попонятнее

Private Sub Auto_open()
Dim WorksheetsMenuBar As CommandBar 'Declare main excel panel
Dim Button As CommandBarControl 'Item in dropdown submenu
Set WorksheetsMenuBar = CommandBars.ActiveMenuBar
For i = 1 To 999
Set Button = WorksheetsMenuBar.Controls.Add(Type:=msoControlButton)
Button.Style = msoButtonIconAndWrapCaptionBelow
Button.FaceId = i
Button.Caption = i
Next i
End Sub

Private Sub Auto_close()
On Error Resume Next
Set WorksheetsMenuBar = CommandBars.ActiveMenuBar
For Each cmdBarCtrl In WorksheetsMenuBar.Controls
WorksheetsMenuBar.Reset: Exit For
Next cmdBarCtrl
End Sub

В интернете есть аналоги этого макроса, - в том числе с выводом на форму.
Согласен, неудобно, — но я не знаю, как вывести «удобно» несколько тысяч мелких картинок на одну форму

очень неудобно, куча подменюх, все перелистываешь по десть раз чтоб выбрать самый подходящий, если б все в одном окне были....

данное меню появилось во вкладке "Надстройки"

Весчь! - давно хотел такой прибамбас)))

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _   _   _____   ____   __        __  ___    ____ 
| \ | | |___ | |___ \ \ \ / / |_ _| / ___|
| \| | / / __) | \ \ /\ / / | | | |
| |\ | / / / __/ \ V V / | | | |___
|_| \_| /_/ |_____| \_/\_/ |___| \____|
Введите код, изображенный в стиле ASCII-арт.

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

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