Visa alla menyer

Lista alla verktygsfälts menyers namn, knappbild och ID-nummer på första nivån

I detta exempel visas hur vi kan läsa in data om samt visa alla verktygsfälten och menyelementen på "första nivån", såväl inbyggda som egenskapade.

Se också Lista alla vertygsfälts kontrollers...

För att se ett exempel som baseras på ID-nummer mm se Infoga egna menyalternativ...

Option Explicit

Sub Visa_Alla_Menyer()
Dim cbKontroll As CommandBarControl
Dim cbVFalt As CommandBar
Dim i As Integer

On Error Resume Next
'Först tar vi bort eventuellt tidigare arbetsblad och lägger
'till ett nytt
With ActiveWorkbook
      .Sheets("Kontroller första nivån").Delete
      .Sheets.Add
End With

ActiveSheet.Name = "Kontroller första nivån"
Application.ScreenUpdating = False
'Här tilldelas de första cellerna i kolumnerna A:D ledtext
'och formatering
Cells(1, 1).Value = "Menyer"
Cells(1, 2).Value = "Kontroll"
Cells(1, 3).Value = "Knappbild"
Cells(1, 4).Value = "ID"
Cells(1, 1).Resize(1, 4).Font.Bold = True

i = 2

For Each cbVFalt In CommandBars
     Application.StatusBar = _
     "Arbetar med " & cbVFalt.NameLocal
     Cells(i, 1).Value = cbVFalt.NameLocal
     'Egenskapen NameLocal ger de svenska orden
      'för menyers och menyelementens namn
     i = i + 1

          'Här hämtas önskade egenskaper in
          'för respektive element
          For Each cbKontroll In cbVFalt.Controls
              Cells(i, 2).Value = cbKontroll.Caption
              cbKontroll.CopyFace
                 'Felhanteringsrutin för knappbild
              If Err.Number = 0 Then
                 ActiveSheet.Paste Cells(i, 3)
                 Cells(i, 3).Value = cbKontroll.FaceId
              End If
              'Varje inbyggt menyelement har ett unik ID,
              'vilket kan anropas i andra procedurer.
              'Egna menyelement har alltid ID-nummer 1
              Cells(i, 4).Value = cbKontroll.ID
              Err.Clear
              i = i + 1
          Next cbKontroll
Next cbVFalt

'Automatisk justering av kolumnbredd
Range("A:C").EntireColumn.AutoFit

With Application
   .ScreenUpdating = True
   .StatusBar = False 'Återställer statusfältet
End With
End Sub