Sub GetID()
Dim cbCtl As CommandBarControl
Dim cbBar As CommandBar
Dim i As Integer
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"
i = 2
For Each cbBar In CommandBars
Application.StatusBar = "Processing Bar " & cbBar.Name
If cbBar.Type = msoBarTypePopup Then
Cells(i, 1).Value = cbBar.Name
i = i + 1
For Each cbCtl In cbBar.Controls
Cells(i, 2).Value = cbCtl.Caption
cbCtl.CopyFace
If Err.Number = 0 Then
ActiveSheet.Paste Cells(i, 3)
Cells(i, 3).Value = cbCtl.FaceId
End If
Cells(i, 4).Value = cbCtl.ID
Err.Clear
i = i + 1
Next cbCtl
End If
Next cbBar
Range("A:B").EntireColumn.AutoFit
Application.StatusBar = False
End Sub