[VBA程序]：如何用VBA动态控制下拉菜单中的项目，使其变灰和恢复正常？

cyt4321

如何用VBA动态控制下拉菜单中的项目，使其变灰和恢复正常？

efan2000

通过枚举菜单栏(MenuBar)或者某一菜单组(MenuGroup)，找到自己要处理的菜单项(PopupMenuItem)，然后使用它的属性Enable，设置为False表示变灰，即不能操作。

cyt4321

是用API函数吗？能给个例子吗？

efan2000

这是个用VBA对菜单进行操作的例子，可以参考一下。

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. Sub Example_Check()
   
6.     ' 这个例子演示了使菜单组“ACAD”中的下拉菜单“工具”中的“拼写检查”菜单项
   
7.     ' 变灰（禁止）的操作
   
8.    
   
9.     ' 返回菜单组“ACAD”
   
10.     Dim MGroupObj As AcadMenuGroup
    
11.     Set MGroupObj = ThisDrawing.Application.MenuGroups("ACAD")
    
12.    
    
13.     ' 返回下拉菜单“工具”
    
14.     Dim PMenuObj As AcadPopupMenu
    
15.     For Each PMenuObj In MGroupObj.Menus
    
16.         If PMenuObj.TagString = "ID_MnTools" Then '通过TagString来检测，
    
17.         ' 也可以通过Name = "工具(&T)"来检测，但是在中文版与英文版中名称是不一样的。
    
18.             Exit For
    
19.         End If
    
20.     Next
    
21. 
    
22.     ' 返回下拉菜单“工具”中的“拼写检查”菜单项
    
23.     Dim PMenuItemObj As AcadPopupMenuItem
    
24.     For Each PMenuItemObj In PMenuObj
    
25.         If PMenuItemObj.TagString = "ID_Spell" Then '通过TagString来检测，
    
26.         '也可以通过Label = "拼写检查(&E)"来检测，但是在中文版与英文版中标签是不一样的。
    
27.             ' 禁止“拼写检查”菜单项
    
28.             PMenuItemObj.Enable = False
    
29.             Exit For
    
30.         End If
    
31.     Next
    
32.     Set PMenuItemObj = Nothing
    
33.     Set PMenuObj = Nothing
    
34.     Set MGroupObj = Nothing
    
35. End Sub
    
36. 
    
37.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> Sub Example_Check()<br />     ' 这个例子演示了使菜单组“ACAD”中的下拉菜单“工具”中的“拼写检查”菜单项<br />     ' 变灰（禁止）的操作<br />     <br />     ' 返回菜单组“ACAD”<br />     Dim MGroupObj As AcadMenuGroup<br />     Set MGroupObj = ThisDrawing.Application.MenuGroups("ACAD")<br />     <br />     ' 返回下拉菜单“工具”<br />     Dim PMenuObj As AcadPopupMenu<br />     For Each PMenuObj In MGroupObj.Menus<br />         If PMenuObj.TagString = "ID_MnTools" Then '通过TagString来检测，<br />         ' 也可以通过Name = "工具(&T)"来检测，但是在中文版与英文版中名称是不一样的。<br />             Exit For<br />         End If<br />     Next<br /> <br />     ' 返回下拉菜单“工具”中的“拼写检查”菜单项<br />     Dim PMenuItemObj As AcadPopupMenuItem<br />     For Each PMenuItemObj In PMenuObj<br />         If PMenuItemObj.TagString = "ID_Spell" Then '通过TagString来检测，<br />         '也可以通过Label = "拼写检查(&E)"来检测，但是在中文版与英文版中标签是不一样的。<br />             ' 禁止“拼写检查”菜单项<br />             PMenuItemObj.Enable = False<br />             Exit For<br />         End If<br />     Next<br />     Set PMenuItemObj = Nothing<br />     Set PMenuObj = Nothing<br />     Set MGroupObj = Nothing<br /> End Sub<br /> <br />   [/FONT]<br />