Public Sub ListAllFaces()
    Btn = MsgBox("This macro will list all of the button faces (over 5000)" & vbCrLf & _
            "in this worksheet." & vbCrLf & vbCrLf & _
            "Are you READY TO PROCEED?", vbOKCancel, "Button Image Listing")
    If Btn = vbCancel Then Exit Sub
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim cbCtl As CommandBarControl
    Dim cbBar As CommandBar
    On Error Resume Next
    Application.ScreenUpdating = False
    Set cbBar = CommandBars.Add(Position:=msoBarFloating, MenuBar:=False, temporary:=True)
    Set cbCtl = cbBar.Controls.Add(Type:=msoControlButton, temporary:=True)
    k = 1
    Do While Err.Number = 0
        For j = 1 To 10
            i = i + 1
            Application.StatusBar = "Face ID = " & i
            cbCtl.FaceId = i
            cbCtl.CopyFace
            If Err.Number <> 0 Then Exit For
            ActiveSheet.Paste Cells(k, j + 1)
            Cells(k, j).Value = i
        Next
        k = k + 1
    Loop
    Application.StatusBar = False
    cbBar.Delete
End Sub