求救：程序中怎么样操作菜单，让菜单项变灰啊，在线等！！

bsynuaa

mccad

[WEB]/object/acad2004/idh_enable.htm[/WEB]

bsynuaa

先谢谢您，但是我不大明白您的程序。
我的意思是：我用了一个登陆框，想先让其他菜单为灰，当登陆成功后，那些菜单再变成可以执行，您的程序好象不是。

efan2000

在弹出登陆框，搜索MenuBa（菜单栏）r中的所有菜单和子菜单，将其变灰。
不过这种方法不是太好，用户使用Menu或者MenuLoad就可以重新加载。
应该在程序中判断是否登录，如没有登录，则不执行。

3kd

你的是什么程序？
在VBA中，你的登陆框不关闭，能点菜单？不登陆不让他进入不就可以了？
请说清楚一点。

bsynuaa

我现在想实现的是：开始我的一些菜单都是灰色的，进入登陆框，正确登陆后才激活那些菜单。而我想问的是怎么样才能用程序实现让菜单变灰和激活！！

efan2000

2. 
   
3. Sub test()
   
4.     Dim PMObj As AcadPopupMenu
   
5.     Dim PMItemObj As AcadPopupMenuItem
   
6.     ' 遍历菜单栏
   
7.     For Each PMObj In Application.MenuBar
   
8.         ' 遍历下拉菜单
   
9.         For Each PMItemObj In PMObj
   
10.             ' 如果菜单项的类型是菜单项（其它类型为分隔条、子菜单）
    
11.             If PMItemObj.Type = acMenuItem Then
    
12.                 ' 如果菜单项是“新建”菜单项
    
13.                 If PMItemObj.TagString = "ID_New" Then
    
14.                     '变灰
    
15.                     PMItemObj.Enable = False
    
16.                 ' 如果菜单项是“打开”菜单项
    
17.                 ElseIf PMItemObj.TagString = "ID_Open" Then
    
18.                     '选中
    
19.                     PMItemObj.Check = True
    
20.                 End If
    
21.             End If
    
22.         Next
    
23.     Next
    
24.     Set PMItemObj = Nothing
    
25.     Set PMObj = Nothing
    
26. End Sub
    

<br /> Sub test()<br />     Dim PMObj As AcadPopupMenu<br />     Dim PMItemObj As AcadPopupMenuItem<br />     ' 遍历菜单栏<br />     For Each PMObj In Application.MenuBar<br />         ' 遍历下拉菜单<br />         For Each PMItemObj In PMObj<br />             ' 如果菜单项的类型是菜单项（其它类型为分隔条、子菜单）<br />             If PMItemObj.Type = acMenuItem Then<br />                 ' 如果菜单项是“新建”菜单项<br />                 If PMItemObj.TagString = "ID_New" Then<br />                     '变灰<br />                     PMItemObj.Enable = False<br />                 ' 如果菜单项是“打开”菜单项<br />                 ElseIf PMItemObj.TagString = "ID_Open" Then<br />                     '选中<br />                     PMItemObj.Check = True<br />                 End If<br />             End If<br />         Next<br />     Next<br />     Set PMItemObj = Nothing<br />     Set PMObj = Nothing<br /> End Sub<br />

bsynuaa

谢谢！！！！！！！！！