Nochmal Controls & FaceId's

      
Hallo
folgender code liefert mir eine Übersicht über die Struktur der Controls in den Commandbars.
Der code erstellt eine commandbar die sich NICHT selber löscht.
Funktioniert so ganz gut. 
Die FaceIds werden mittlerweile auch abgebildet
Danke nochmal an Ramses und Ha_Jo.
Allerdings habe ich jetzt einen Fehler entdeckt und weiss nicht wo er herkommt.
Unter commandbar Zeichnen->control Zeichnen->control Autoform ändern 
liegen standardmäßig nochmal 5 controls.
Die werden von dem Code leider erfolgreich ignoriert.
Option Explicit
Public Sub Zeig_alles()
    Dim reset As CommandBarControl
    Dim cb As CommandBar
    Dim c As CommandBar
    Dim a As CommandBar 'Zähler
    Dim b As CommandBarControl
    Dim cneu As CommandBarControl 'neu
    Dim d As CommandBarControl 'Zähler
    Dim e As CommandBarControl 'neu
    Dim f As CommandBarControl 'Zähler
    Dim g As CommandBarControl 'neu
    Dim h As CommandBarControl 'zähler
    Dim i As CommandBarControl 'neu
On Error Resume Next
DoEvents
Application.ScreenUpdating = False
For Each cb In Application.CommandBars
If cb.Name = "Alle Infos" Then cb.Delete
Next
Set c = Application.CommandBars.Add(Name:="Alle Infos")
Set b = Application.CommandBars("Alle Infos").Controls.Add(msoControlPopup)
Set reset = Application.CommandBars("Alle Infos").Controls.Add(msoControlButton)
b.Caption = "ID's "
With reset 'für Neuberechnung
    .Caption = "Reset"
    .Style = msoButtonIconAndCaption
    .FaceId = 940
    .OnAction = "Zeig_alles"
End With
c.Visible = True
For Each a In Application.CommandBars
    If a.Name <> "Alle Infos" Then
        Set cneu = b.Controls.Add(Type:=msoControlPopup)
                cneu.Caption = a.NameLocal & " ID:=" & a.ID
            For Each d In a.Controls
            If Not d Is Nothing Then
                    Set e = cneu.Controls.Add(Type:=d.Type)
                    With e 'Eigenschaften des Originals abschreiben
                        .Caption = d.Caption & " ID:=" & d.ID
                        .Style = d.Style
                        .FaceId = d.ID
                    End With
                End If
                For Each f In d.Controls
                    If Not f Is Nothing Then
                        Set g = e.Controls.Add(Type:=f.Type)
                        With g 'Eigenschaften des Originals abschreiben
                            .Caption = f.Caption & " ID:=" & f.ID
                            .Style = f.Style
                            .FaceId = f.ID
                        End With
                    End If
                    For Each h In f.Controls
                        If Not h Is Nothing Then
                            Set i = g.Controls.Add(Type:=h.Type)
                            With i 'Eigenschaften des Originals abschreiben
                                .Caption = h.Caption & " ID:=" & h.ID
                                .Style = h.Style
                                .FaceId = h.ID
                            End With
                        End If
                    Next
                Next
            Next
    End If
Next
Application.ScreenUpdating = True
Set a = Nothing
Set b = Nothing
Set cb = Nothing
Set c = Nothing
Set b = Nothing
Set cneu = Nothing
Set e = Nothing
Set f = Nothing
Set g = Nothing
Set h = Nothing
Set i = Nothing
End Sub