Sub ListFirstLevelControls()

    'Список элементов первого уровня

    Dim ctl As CommandBarControl
    Dim cbr As CommandBar
    Dim iRow As Integer
    Dim sheet As Worksheet
    
    'Очищаем лист
    Set sheet = ActiveSheet
    sheet.Cells.Clear
    sheet.DrawingObjects.Delete
    
    On Error Resume Next
    Application.ScreenUpdating = False
    
    'Заголовки
    Cells(1, 1).Value = "CommandBar"
    Cells(1, 2).Value = "Control"
    Cells(1, 3).Value = "FaceID"
    Cells(1, 4).Value = "ID"
    Cells(1, 1).Resize(1, 4).Font.Bold = True
    
    'Начинаем со второй строки
    iRow = 2
    
    'Итерация CommandBar'ов
    For Each cbr In CommandBars
    
        Application.StatusBar = "Processing Bar => " & cbr.Name
        Cells(iRow, 1).Value = cbr.Name
        iRow = iRow + 1
        
        'Итерация всех элементов в commandbar'ах
        For Each ctl In cbr.Controls
            Cells(iRow, 2).Value = ctl.Caption
            'Пытаемся достать изображение
            ctl.CopyFace
            If Err.Number = 0 Then
                ActiveSheet.Paste Cells(iRow, 3)
                Cells(iRow, 3).Value = ctl.FaceId
            End If
            Cells(iRow, 4).Value = ctl.ID
            Err.Clear
            iRow = iRow + 1
        Next ctl
    Next cbr
    
    Range("A:D").EntireColumn.AutoFit
    Application.StatusBar = False
    
End Sub

Sub ListAllFaces()

    'Все изображения

    Dim iFaceId As Integer 'Текущее FaceId
    Dim iColumn As Integer 'Текущий столбец current column in worksheet
    Dim iRow As Integer    'Текущая строка
    Dim ctl As CommandBarControl
    Dim cbr As CommandBar
    Dim sheet As Worksheet

    'Очищаем лист
    Set sheet = ActiveSheet
    sheet.Cells.Clear
    sheet.DrawingObjects.Delete
    
    On Error GoTo Recover
    Application.ScreenUpdating = False
    
    'Создаём временную панель с одной кнопкой,
    'которая будет содержать изображение
    Set cbr = CommandBars.Add(Position:=msoBarFloating, MenuBar:=False, Temporary:=True)
    Set ctl = cbr.Controls.Add(Type:=msoControlButton, Temporary:=True)
    
    iRow = 1
    Do
        For iColumn = 1 To 10
            iFaceId = iFaceId + 1
            Application.StatusBar = "FaceID = " & iFaceId
            'Присваиваем FaceId кнопке
            ctl.FaceId = iFaceId
            'Пытаемся скопировать изображение на лист
            ctl.CopyFace
            sheet.Paste Cells(iRow, iColumn + 1)
            Cells(iRow, iColumn).Value = iFaceId
        Next iColumn
        iRow = iRow + 1
    Loop

Recover:
    If Err.Number = 1004 Then Resume Next
    Application.StatusBar = False
    cbr.Delete

End Sub

Sub ListAllControls()

    'Список элементов всех уровней

    Dim cbr As CommandBar
    Dim rng As Range
    Dim ctl As CommandBarControl
    
    'Очищаем лист
    With ActiveSheet
        .Cells.Clear
        .DrawingObjects.Delete
    End With

    Application.ScreenUpdating = False
    
    'Начинаем с ячейки A1
    Set rng = Range("A1")
    
    'Итерация всех CommandBar'ов
    For Each cbr In Application.CommandBars
        Application.StatusBar = "Processing Bar => " & cbr.Name
        'Имя панели
        rng.Value = cbr.Name
        'Элементы на панели
        For Each ctl In cbr.Controls
        'ListControls - детали элемента
        Set rng = rng.Offset(ListControls(ctl, rng))
        Next ctl
    Next cbr
    
    Range("A:J").EntireColumn.AutoFit
    Application.StatusBar = False
    
End Sub

Function ListControls(ctl As CommandBarControl, rng As Range) As Long
    
    Dim lOffset As Long             'Текущая строка относительно rng
    Dim ctlSub As CommandBarControl 'Элемент, содержащийся в ctl
    
    On Error Resume Next
    
    lOffset = 0
    
    'Имя и тип элемента
    rng.Offset(lOffset, 1).Value = ctl.Caption
    rng.Offset(lOffset, 2).Value = ctl.Type
    
    'Пытаемся скопировать изображение.
    ctl.CopyFace
    If Err.Number = 0 Then
        ActiveSheet.Paste rng.Offset(lOffset, 3)
        rng.Offset(lOffset, 3).Value = ctl.FaceId
    End If
    
    Err.Clear
    
    'Проверяем тип элемента
    Select Case ctl.Type
        Case 1, 2, 4, 6, 7, 13, 18
            'Ничего не делаем для этих типов
        Case Else
        'Вызываем ListControls рекурсивно, если элемент содержит другие элементы
        For Each ctlSub In ctl.Controls
            lOffset = lOffset + ListControls(ctlSub, rng.Offset(lOffset, 2))
        Next ctlSub
        lOffset = lOffset - 1
    End Select
    
    ListControls = lOffset + 1
    
End Function