2007/2010版本菜单栏里定制个性化2003菜单栏

nothingwmm

在2007版和2010版中效果如图所示：
(源代码回复可见)

[hide ] 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) '添加命令栏，名字为sMenuName，是一个临时菜单栏，即常用菜单项
    '参考：Set newMbar = CommandBars.Add _
     (Name:="newMenubar", Position:=msoBarRight, _
      MenuBar:=True, temporary:=True)
    With cBar
        .Visible = True '临时菜单栏可见
        For iMenu = 1 To 10
            Set cBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30001 + iMenu) '依次添加2003版的弹出是菜单
        Next iMenu
        Set cBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30022) '图表菜单
        Set cBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30177) '自选图形
    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
[/hide]
以上命令代码可以随意定制，详细的Msocotrolbutton的ID，名字以及图标见附件。有了这个对照表就可以任意定制常用的功能菜单了。

参考：http://blog.livedoor.jp/andrewe/archives/50820196.html
感谢：百宝箱里的获取ID 功能，以及ttgg93版主和阿木版主以及chrisfang的贡献

老元子啊

回复 nothingwmm 的帖子

学习一下，充实自己。

amulee

貌似几句话就完结了

1. Sub Test()
   
2.     Set tbar = Application.CommandBars.Add("mybar")
   
3.     tbar.Visible = True
   
4.     For Each a In Array(1, 4, 8, 10, 13, 18, 23, 27, 28)
   
5.         Application.CommandBars("Built-in Menus").Controls(a).Copy tbar
   
6.     Next
   
7. End Sub

复制代码

参考：出一个VBA题目:为Excel 2007设计经典菜单 http://www.exceltip.net/thread-5678-1-1-11314.html

nothingwmm

amulee 发表于 2011-1-21 14:53
貌似几句话就完结了参考：出一个VBA题目:为Excel 2007设计经典菜单 http://www.exceltip.net/thread-5678-1 ...

果真如此，哈哈，这样就可以自定义自己需要的功能，就是那些ID 我还不知道在那里找到，如果找到那些ID ，想自己自定义工具栏

amulee

要ID的话，自己编一段程序遍历所有的工具栏和按钮就能得到了。

轩辕轼轲

学习一下

nothingwmm

amulee 发表于 2011-1-21 15:24
要ID的话，自己编一段程序遍历所有的工具栏和按钮就能得到了。

该代码我还不会写，提问后版主搞定了。谢谢ttgg93版主和你
见：http://www.excelpx.com/thread-156717-1-1.html

1. 
   
2. Sub MenuList()
   
3.        On Error Resume Next
   
4.        Dim Nx As CommandBar
   
5.        Dim I As Integer
   
6.        For Each Nx In Application.CommandBars
   
7.            I = I + 1
   
8.            Range("A" & I).Value = Nx.Name
   
9.            Range("C" & I).Value = Nx.NameLocal
   
10.            For Each X In Application.CommandBars(Nx.Name).Controls
    
11.                I = I + 1
    
12.                Range("B" & I).Value = X.ID
    
13.                Range("C" & I).Value = X.Caption
    
14.                Range("D" & I).Value = X.FaceId
    
15.            Next
    
16.        Next
    
17.    End Sub

复制代码

轩辕轼轲

这个帖子要收藏

学习E

学习……………………………………

twtthduu

学习来了，我来学习来了