简单代码生成2003经典菜单并有效执行

Sub 经典菜单()
On Error Resume Next
Dim Menu As CommandBarControl, SubMenu As CommandBarControl, SubsubMenu As CommandBarControl, i, n, m
Application.CommandBars(1).Controls("怀旧菜单(&F)").Delete
Set Menu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
Menu.Caption = "经典菜单"
For Each n In Application.CommandBars(1).Controls                              'Word为CommandBars(40),Excel为CommandBars(1)
Set SubMenu = Menu.Controls.Add(msoControlPopup, 1, , , True)
With SubMenu
.Caption = n.Caption
.BeginGroup = True
.FaceId = n.FaceId
'.OnAction = n.OnAction
End With
For Each m In n.Controls
With SubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = m.Caption
.BeginGroup = True
.FaceId = m.FaceId
.OnAction = "'经典菜单执行 " & n.Index & "," & m.Index & "'"          '两个参数
Debug.Print m.Caption
End With
Next m
Next n
End Sub

 

Sub 经典菜单执行(a As Long, b As Long)
  CommandBars(1).Controls(a).Controls(b).Execute
End Sub

 

注:OnAction多参数(字符型):   "’MyProcedure """ & strText & """’"

 

Sub Test()  'excel 更简单

    Set tbar = Application.CommandBars.Add("mybar")

    tbar.Visible = True

    For Each a In Array(1, 4, 8, 10, 13, 18, 23, 27, 28)

        Application.CommandBars("Built-in Menus").Controls(a).Copy tbar

    Next

End Sub

 

 

 

 

Private Sub ShowOldStyleMenus()
    On Error Resume Next
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    Dim sMenuName As String
    Dim sToolbarName As String
    Dim iMenu As Integer

    sMenuName = "Old Style Menu"
    sToolbarName = "Old StyleToolbar"

    CommandBars(sMenuName).Delete

    Set cBar = CommandBars.Add(sMenuName, , , True)

    With cBar

        .Visible = True

        For iMenu = 1 To 10

            Set cBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30001 + iMenu)

        Next iMenu

        Set cBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30022) 'Chart
        Set cBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30177) 'AutoShapes

    End With

    CommandBars(sToolbarName).Delete

    Set cBar = CommandBars.Add(sToolbarName, , , True)

    With cBar

        .Visible = True

        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=2520) 'New
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=23) 'Open
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=3) 'Save
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=4) 'Print
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=109) 'Print Preview
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=2) 'Spelling
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=21) 'Cut
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=19) 'Copy
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=22) 'Paste
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=108) 'Format Painter
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=210) 'Sort Ascending
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=211) 'Sort Descending
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=984) 'Help
        Set cBarCtrl = .Controls.Add(Type:=msoControlComboBox, ID:=1728) 'Font
        Set cBarCtrl = .Controls.Add(Type:=msoControlComboBox, ID:=1731) 'Font Size
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=113) 'Bold
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=114) 'Italic
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=115) 'Underline
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=120) 'Align Left
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=122) 'Center
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=121) 'Align Right
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=402) 'Merge and Center
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=395) 'Accounting Number Format
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=396) 'Percent Style
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=397) 'Comma Style
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=398) 'Increase Decimal
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=399) 'Decrease Decimal
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=3162) 'Decrease Indent
        Set cBarCtrl = .Controls.Add(Type:=msoControlButton, ID:=3161) 'Increase Indent

    End With

    Set cBar = Nothing
    Set cBarCtrl = Nothing

    On Error GoTo 0
End Sub