获取commandbars子对象的名称与类型

dogingate

最近在学commandbars，但是每次查找很麻烦，就参考书籍写了下面这段代码，这样找起来就方便多了

Sub test()
Dim k As Integer
Dim cbar As CommandBar

Worksheets("工具栏").UsedRange.ClearContents

tt = Array("name", "namelocal", "type", "type", "type", "height", "width", "builtin", "left", "top", "position", "visible")
Range(Cells(1, 1), Cells(1, UBound(tt, 1))).Value = tt
For Each cbar In CommandBars
    With Worksheets("工具栏")
        .Cells(k + 2, 1) = cbar.Name
        .Cells(k + 2, 2) = cbar.NameLocal
        .Cells(k + 2, 3) = IIf(cbar.Type = 1, "菜单栏", IIf(cbar.Type = 0, "默认菜单栏", "快捷菜单"))
        .Cells(k + 2, 4) = IIf(cbar.Type = 1, "msoBarTypeMenuBar", IIf(cbar.Type = 0, "msoBarTypeNormal", "msoBarTypePopup"))
        .Cells(k + 2, 5) = cbar.Type
        .Cells(k + 2, 6) = cbar.Height
        .Cells(k + 2, 7) = cbar.Width
        .Cells(k + 2, 8) = cbar.BuiltIn
        .Cells(k + 2, 9) = cbar.Left
        .Cells(k + 2, 10) = cbar.Top
        .Cells(k + 2, 11) = cbar.Position
        .Cells(k + 2, 12) = cbar.Visible
        .Cells(k + 2, 13) = cbar.Enabled
    End With
    k = k + 1
Next cbar
End Sub

dogingate

重新改写了下
Sub test()
Dim k As Integer
Dim cbar As CommandBar

Worksheets("工具栏").UsedRange.ClearContents

tt = Array("name", "namelocal", "index", "type", "type", "type", "height", "width", "builtin", "left", "top", "position", "visible", "enable")
Range("a1").Resize(1, UBound(tt) - LBound(tt) + 1).Value = tt
For Each cbar In CommandBars
    With Worksheets("工具栏")
        .Cells(k + 2, 1) = cbar.Name
        .Cells(k + 2, 2) = cbar.NameLocal
        .Cells(k + 2, 3) = cbar.Index
        .Cells(k + 2, 4) = IIf(cbar.Type = 1, "菜单栏", IIf(cbar.Type = 0, "默认菜单栏", "快捷菜单"))
        .Cells(k + 2, 5) = IIf(cbar.Type = 1, "msoBarTypeMenuBar", IIf(cbar.Type = 0, "msoBarTypeNormal", "msoBarTypePopup"))
        .Cells(k + 2, 6) = cbar.Type
        .Cells(k + 2, 7) = cbar.Height
        .Cells(k + 2, 8) = cbar.Width
        .Cells(k + 2, 9) = cbar.BuiltIn
        .Cells(k + 2, 10) = cbar.Left
        .Cells(k + 2, 11) = cbar.Top
        .Cells(k + 2, 12) = cbar.Position
        .Cells(k + 2, 13) = cbar.Visible
        .Cells(k + 2, 14) = cbar.Enabled
    End With
    k = k + 1
Next cbar
End Sub

dogingate

Sub CommandbarsListing()
Application.ScreenUpdating = False
On Error Resume Next
Dim oCbar As Object
Dim intRowNum As Integer
intRowNum = 1
Dim oSht As Object
Set oSht = ThisWorkbook.Worksheets("工具栏菜单项")
With oSht
    .Cells(intRowNum, 1) = "Index"
    .Cells(intRowNum, 2) = "Name"
    .Cells(intRowNum, 3) = "NameLocal"
    .Cells(intRowNum, 4) = "Type"
    .Cells(intRowNum, 5) = "Position"
    .Cells(intRowNum, 6) = "Proteciton"
    .Cells(intRowNum, 7) = "Top"
    .Cells(intRowNum, 8) = "Left"
    .Cells(intRowNum, 9) = "Width"
    .Cells(intRowNum, 10) = "Height"
   
    .Cells(intRowNum, 11) = "Index"
    .Cells(intRowNum, 12) = "Type"
    .Cells(intRowNum, 13) = "Type"
    .Cells(intRowNum, 14) = "ID"
    .Cells(intRowNum, 15) = "Caption"
    .Cells(intRowNum, 16) = "DescriptionText"
    .Cells(intRowNum, 17) = "OnAction"
    .Cells(intRowNum, 18) = "Parameter"
    .Cells(intRowNum, 19) = "Parent"
    .Cells(intRowNum, 20) = "Tag"
End With
intRowNum = intRowNum + 1
For Each oCbar In Application.CommandBars
    If oCbar.BuiltIn Then
        With oSht
            .Cells(intRowNum, 1) = oCbar.Index
            .Cells(intRowNum, 2) = oCbar.Name
            .Cells(intRowNum, 3) = oCbar.NameLocal
            .Cells(intRowNum, 4) = oCbar.Type
            .Cells(intRowNum, 5) = oCbar.Position
            .Cells(intRowNum, 6) = oCbar.Protection
            .Cells(intRowNum, 7) = oCbar.Top
            .Cells(intRowNum, 8) = oCbar.Left
            .Cells(intRowNum, 9) = oCbar.Width
            .Cells(intRowNum, 10) = oCbar.Height
        End With
        For Each oCtrl In oCbar.Controls
            If oCtrl.BuiltIn Then
                With oSht
                    .Cells(intRowNum, 11) = oCtrl.Index
                    .Cells(intRowNum, 12) = oCtrl.Type
                    .Cells(intRowNum, 13) = strMsoControlType(oCtrl.Type)
                    .Cells(intRowNum, 14) = oCtrl.ID
                    .Cells(intRowNum, 15) = oCtrl.Caption
                    .Cells(intRowNum, 16) = oCtrl.DescriptionText
                    .Cells(intRowNum, 17) = oCtrl.OnAction7
                    .Cells(intRowNum, 18) = oCtrl.Parameter
                    .Cells(intRowNum, 19) = oCtrl.Parent
                    .Cells(intRowNum, 20) = oCtrl.Tag
                End With
            End If
            intRowNum = intRowNum + 1
        Next oCtrl
    End If
Next oCbar

Call ColumnsAutofiting

Application.ScreenUpdating = True
Application.Goto oSht.Range("a1"), True

End Sub