word文档自定义右键问题

loquat

1. 
   
2. Dim NewMenu1 As CommandBarPopup
   
3. Set NewMenu1 = Application.CommandBars("Text").Controls.Add(Type:=msoControlPopup, Before:=1)
   
4. with NewMenu1
   
5.     .caption = "MyMenu"
   
6.     .visible = true
   
7.     with .controls.add(type:=msoControlButton)
   
8.         .caption = "Menu1"
   
9.         .OnAction = "MySub1"
   
10.     end with
    
11.     with .controls.add(type:=msoControlButton)
    
12.         .caption = "Menu2"
    
13.         .OnAction = "MySub2"
    
14.     end with
    
15. end with
    

复制代码

这样建立的右键菜单只对文本有效，不能对文档中所有对象有效。
比如如果是列表，就要重新再定义一个NewMenu2 = Application.CommandBars("Lists").Controls.Add(Type:=msoControlPopup, Before:=1)
若果是嵌入式图片，要重新定义一个NewMenu3 = Application.CommandBars("Inline Piture").Controls.Add(Type:=msoControlPopup, Before:=1)

有没有只定义一个CommandBarPopup，所文档中的所有对象都有效？

loquat

http://club.excelhome.net/forum. ... ead&tid=1038554
看到Excel里有这样的用法，请问谁知道Word有木有这样的简化方法

loquat

1.     Set NewButton1 = Application.CommandBars("Text").Controls.Add(Type:=msoControlPopup, Before:=1)
   
2.     Set NewButton2 = Application.CommandBars("Whole Table").Controls.Add(Type:=msoControlPopup, Before:=1)
   
3.     Set NewButton3 = Application.CommandBars("Inline Picture").Controls.Add(Type:=msoControlPopup, Before:=1)
   
4.     Set NewButton4 = Application.CommandBars("Floating Picture").Controls.Add(Type:=msoControlPopup, Before:=1)
   
5.    
   
6. With NewButton1
   
7.         .Caption = "模板菜单"    '命令名称
   
8.         .Visible = True          '可见
   
9.         With .Controls.Add(Type:=msoControlButton)
   
10.             .Caption = "域与题注"
    
11.             .OnAction = "菜单"
    
12.             .Visible = True
    
13.         End With
    
14.         With .Controls.Add(Type:=msoControlButton)
    
15.             .Caption = "表格设置"
    
16.             .OnAction = "菜单"
    
17.             .Visible = True
    
18.         End With
    
19.         With .Controls.Add(Type:=msoControlButton)
    
20.             .Caption = "图片设置"
    
21.             .OnAction = "菜单"
    
22.             .Visible = True
    
23.         End With
    
24.         With .Controls.Add(Type:=msoControlButton)
    
25.             .Caption = "其他设置"
    
26.             .OnAction = "菜单"
    
27.             .Visible = True
    
28.         End With
    
29.         With .Controls.Add(Type:=msoControlButton)
    
30.             .Caption = "更多功能"
    
31.             .OnAction = "菜单"
    
32.             .Visible = True
    
33.         End With
    
34. End With
    
35. With NewButton2
    
36.      '完全一样的代码块
    
37. End With
    
38. With NewButton3
    
39.      '完全一样的代码块
    
40. End With
    
41. With NewButton4
    
42.      '完全一样的代码块
    
43. End With
    
44. 
    
45. '难道不应该想个办法这样操作吗？
    
46. arr = Array("Text", "Whole Table", "Inline Picture", "Floating Picture")
    
47. For i = LBound(arr) To UBound(arr)
    
48.     Set "NewButton" & i + 1 = Application.CommandBars(arr(i)).Controls.Add(Type:=msoControlButton, Before:=1)
    
49.     With "NewButton" & i + 1
    
50.         '完全一样的代码块
    
51.     End With
    
52. Next i

复制代码

zhanglei1371

这个应该可以吧：
Sub 批量添加右键菜单()
On Error Resume Next
    Dim arr()
    arr = Array("Text", "Whole Table", "Inline Picture", "Floating Picture")
    For Each A In arr
    Application.CommandBars(A).Controls("模板菜单").Delete
        Set NewButton = Application.CommandBars(A).Controls.Add(Type:=msoControlPopup, Before:=1)
        With NewButton
            .Caption = "模板菜单"    '命令名称
            .Visible = True          '可见
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "域与题注"
                .OnAction = "菜单"
                .Visible = True
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "表格设置"
                .OnAction = "菜单"
                .Visible = True
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "图片设置"
                .OnAction = "菜单"
                .Visible = True
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "其他设置"
                .OnAction = "菜单"
                .Visible = True
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "更多功能"
                .OnAction = "菜单"
                .Visible = True
            End With
        End With
    Next
End Sub

loquat

zhanglei1371 发表于 2013-7-22 19:52
这个应该可以吧：
Sub 批量添加右键菜单()
On Error Resume Next

感谢，我一直以为NewButtuon这个对象不能重复使用。。。

tangqingfu

备注一下，下次学习