FaceId свои иконки для контекстных меню

Option Compare Database
Option Explicit
'Было на: http://hiprog.com/forum/read.php?id_forum=1&id_theme=102111
'Стартует вызовом BrowserFaceID 0
'А иконки листаются верхними стрелочками на самой панели меню, которые вызывают процедуру с параметром -1 или +1
'У меня, например, выделен модуль BuildBar для работы с меню
'
'Пример использования:
'На форме редактирования меню базы (пользовательского меню, дерево которого читается с серверной таблицы) установлена кнопочка faceID на нее повешен вызов BrowserFaceID 0
'Когда мне надо выбрать значок для пользовательского меню, я наживамю кнопочку, появляется панель меню и верхними стрелочками я листаю иконки, всплывающие тултипы на которых показывают номер FaceID
Dim FID1&, FID2&
 
Function BrowserFaceID(q&)
' передаются параметры -1(назад 100), 1(вперед 100), 0(старт меню)
    Dim NewButton As Object, oPopUp As Object, cmbs As Object
    Dim bl As Boolean, i&
 
bl = False
 
On Error GoTo err211:
 
Set cmbs = Application.CommandBars
' - - -
For Each oPopUp In cmbs
    If oPopUp.Name = "FaceIds" Then bl = True
Next
' - - -
If Not bl Then
   Set oPopUp = Application.CommandBars.Add(Name:="FaceIds", Temporary:=True)
    With oPopUp.Controls.Add(Type:=1)
        .faceID = 41
        .OnAction = "=BrowserFaceID(-1)"
        .Width = 115
        .Caption = "Назад"
    End With
    With oPopUp.Controls.Add(Type:=1)
        .faceID = 39
        .OnAction = "=BrowserFaceID(1)"
        .Caption = "Вперед"
        .Width = 115
    End With
Else
    Set oPopUp = Application.CommandBars("FaceIds")
End If
' - - -
With oPopUp
    .Visible = False
 
    Select Case q
    Case -1
        If FID1 = 1 Then FID1 = 2901 Else FID1 = FID1 - 100
    Case 1
        If FID1 = 2901 Then FID1 = 1 Else FID1 = FID1 + 100
    Case 0
        FID1 = 1
    End Select
        FID2 = FID1 + 99
      'Debug.Print FID1 & " - " & FID2
    
    For Each NewButton In .Controls
       If Not (NewButton.Caption = "Назад" Or NewButton.Caption = "Вперед") Then NewButton.Delete
    Next
' - - -
    For i = FID1 To FID2
        With .Controls.Add(Type:=1)
        .faceID = i
        .Caption = "FaceID = " & i
        End With
    Next i
' - - -
    .Width = 250
    .Visible = True
End With
 
Set oPopUp = Nothing
Set cmbs = Nothing
Exit Function
' - - -
err211:
Debug.Print Err.Description
Stop
End Function