求高手纠正宏工程里面的创建菜单的自定义函数

清风明月名字

上面宏工程的代码，我的总体设想是，我每次打开一个窗体，它就会帮我创建一个按钮，这样就避免了我再去查找启动这个窗体的宏了，运行菜单就行了。所以按钮只能运行一次创建一个。
我写了一套代码，是创建多级菜单的。
我碰到的问题是：
如果初次创建，三级菜单都会被成功创建。第二次运行的时候要在上次创建的菜单中添加按钮，则失败了。我跟踪代码发现，“菜单二”就无法获得对象，也就无法创建第二个按钮。

希望有高手能帮我解决，纠正里面的创建菜单的自定义函数。
下面是宏工程中的自定义函数之一：


Function 创建三级菜单按钮(一级菜单名, 二级菜单名, 三级菜单名, VBA或LSP, 按钮标题, 命令)
        On Error Resume Next
        Dim macro As String
        macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) '这是在向命令行发送命令时需要的前缀。

        Dim currMenuGroup As AcadMenuGroup
        Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

        '下面是创建菜单“工”
        Dim 菜单一 As AcadPopupMenu
        Set 菜单一 = currMenuGroup.Menus.Add(一级菜单名 & Chr(Asc("&"))) '这是说在没有时创建菜单“小多”
        Set 菜单一 = currMenuGroup.Menus(一级菜单名 & Chr(Asc("&"))) '这是说在已有菜单“小多”时就让它赋给变量“newMenu”

        Dim 菜单二 As AcadPopupMenu
        Set 菜单二 = 菜单一.AddSubMenu(菜单一.Count + 1, 二级菜单名 & Chr(Asc("&")))
        Set 菜单二 = 菜单一.Item(二级菜单名 & Chr(Asc("&")))

        Dim 菜单三 As AcadPopupMenu
        Set 菜单三 = 菜单二.AddSubMenu(菜单二.Count + 1, 三级菜单名 & Chr(Asc("&")))
        Set 菜单三 = 菜单二.Items(三级菜单名 & Chr(Asc("&")))

        Dim subMenuItemPoint As AcadPopupMenuItem
        Set subMenuItemPoint = 菜单三.Item(按钮标题)
        subMenuItemPoint.Delete '是如果存在以程序文件简单名为名的按钮，则删除它，再创建，以免同名而内容不同的错误

        If VBA或LSP = "LSP" Then
            '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令
            Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")
        Else
             Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")
        End If

菜单一.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)

End Function

efan2000

创建三个通用函数，简化操作。

1. ' AddMenu 在菜单组中创建菜单，如果菜单已经存在，直接返回
   
2. ' mg 菜单组
   
3. ' name 要创建的菜单名称
   
4. Function AddMenu(ByVal mg As AcadMenuGroup, ByVal name As String) As AcadPopupMenu
   
5.     Dim pm As AcadPopupMenu
   
6.     Dim b As Boolean
   
7.     b = False
   
8.     Dim i As Integer
   
9.     For i = 0 To mg.Menus.Count - 1
   
10.         If mg.Menus(i).name = name Then
    
11.             Set pm = mg.Menus(i)
    
12.             b = True
    
13.             Exit For
    
14.         End If
    
15.     Next
    
16.     If b = False Then
    
17.         Set pm = mg.Menus.Add(name)
    
18.     End If
    
19.     Set AddMenu = pm
    
20. End Function
    
21. 
    
22. ' AddSubMenu 在菜单、子菜单中创建子菜单，如果子菜单已经存在，直接返回
    
23. ' parentpm 父级菜单
    
24. ' caption 要创建的子菜单标题
    
25. Function AddSubMenu(ByVal parentpm As AcadPopupMenu, ByVal caption As String) As AcadPopupMenu
    
26.     Dim pm As AcadPopupMenu
    
27.     Dim b As Boolean
    
28.     b = False
    
29.     Dim i As Integer
    
30.     For i = 0 To parentpm.Count - 1
    
31.         If parentpm(i).caption = caption Then
    
32.             Set pm = parentpm(i).SubMenu
    
33.             b = True
    
34.             Exit For
    
35.         End If
    
36.     Next
    
37.     If b = False Then
    
38.         Set pm = parentpm.AddSubMenu(parentpm.Count + 1, caption)
    
39.     End If
    
40.     Set AddSubMenu = pm
    
41. End Function
    
42. 
    
43. ' AddMenuItem 在菜单、子菜单中创建菜单项，如果delete为真，先删除菜单项再创建。如果delete为假，菜单项已经存在时直接返回
    
44. ' parentpm 父级菜单
    
45. ' label 要创建的菜单项标签
    
46. ' macro 要创建的菜单项宏
    
47. ' delete 是否先删除菜单项
    
48. Function AddMenuItem(ByVal parentpm As AcadPopupMenu, ByVal label As String, ByVal macro As String, Optional ByVal delete As Boolean = True) As AcadPopupMenuItem
    
49.     Dim pmi As AcadPopupMenuItem
    
50.     Dim b As Boolean
    
51.     b = False
    
52.     Dim i As Integer
    
53.     For i = 0 To parentpm.Count - 1
    
54.         If parentpm(i).caption = label Then
    
55.             Set pmi = parentpm(i)
    
56.             If delete = True Then
    
57.                 pmi.delete
    
58.                 b = False
    
59.             Else
    
60.                 b = True
    
61.             End If
    
62.             Exit For
    
63.         End If
    
64.     Next
    
65.     If b = False Then
    
66.         Set pmi = parentpm.AddMenuItem(parentpm.Count + 1, label, macro)
    
67.     End If
    
68.     Set AddMenuItem = pmi
    
69. End Function

' AddMenu 在菜单组中创建菜单，如果菜单已经存在，直接返回<br /> ' mg 菜单组<br /> ' name 要创建的菜单名称<br /> Function AddMenu(ByVal mg As AcadMenuGroup, ByVal name As String) As AcadPopupMenu<br />     Dim pm As AcadPopupMenu<br />     Dim b As Boolean<br />     b = False<br />     Dim i As Integer<br />     For i = 0 To mg.Menus.Count - 1<br />         If mg.Menus(i).name = name Then<br />             Set pm = mg.Menus(i)<br />             b = True<br />             Exit For<br />         End If<br />     Next<br />     If b = False Then<br />         Set pm = mg.Menus.Add(name)<br />     End If<br />     Set AddMenu = pm<br /> End Function<br /> <br /> ' AddSubMenu 在菜单、子菜单中创建子菜单，如果子菜单已经存在，直接返回<br /> ' parentpm 父级菜单<br /> ' caption 要创建的子菜单标题<br /> Function AddSubMenu(ByVal parentpm As AcadPopupMenu, ByVal caption As String) As AcadPopupMenu<br />     Dim pm As AcadPopupMenu<br />     Dim b As Boolean<br />     b = False<br />     Dim i As Integer<br />     For i = 0 To parentpm.Count - 1<br />         If parentpm(i).caption = caption Then<br />             Set pm = parentpm(i).SubMenu<br />             b = True<br />             Exit For<br />         End If<br />     Next<br />     If b = False Then<br />         Set pm = parentpm.AddSubMenu(parentpm.Count + 1, caption)<br />     End If<br />     Set AddSubMenu = pm<br /> End Function<br /> <br /> ' AddMenuItem 在菜单、子菜单中创建菜单项，如果delete为真，先删除菜单项再创建。如果delete为假，菜单项已经存在时直接返回<br /> ' parentpm 父级菜单<br /> ' label 要创建的菜单项标签<br /> ' macro 要创建的菜单项宏<br /> ' delete 是否先删除菜单项<br /> Function AddMenuItem(ByVal parentpm As AcadPopupMenu, ByVal label As String, ByVal macro As String, Optional ByVal delete As Boolean = True) As AcadPopupMenuItem<br />     Dim pmi As AcadPopupMenuItem<br />     Dim b As Boolean<br />     b = False<br />     Dim i As Integer<br />     For i = 0 To parentpm.Count - 1<br />         If parentpm(i).caption = label Then<br />             Set pmi = parentpm(i)<br />             If delete = True Then<br />                 pmi.delete<br />                 b = False<br />             Else<br />                 b = True<br />             End If<br />             Exit For<br />         End If<br />     Next<br />     If b = False Then<br />         Set pmi = parentpm.AddMenuItem(parentpm.Count + 1, label, macro)<br />     End If<br />     Set AddMenuItem = pmi<br /> End Function

最后过程：

1. Function 创建三级菜单按钮(一级菜单名, 二级菜单名, 三级菜单名, VBA或LSP, 按钮标题, 命令)
   
2.         'On Error Resume Next
   
3.         Dim macro As String
   
4.         macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) '这是在向命令行发送命令时需要的前缀。
   
5. 
   
6.         Dim currMenuGroup As AcadMenuGroup
   
7.         Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
   
8. 
   
9.         '下面是创建菜单“工”
   
10.         Dim 菜单一 As AcadPopupMenu
    
11.         Set 菜单一 = AddMenu(currMenuGroup, 一级菜单名 & Chr(Asc("&")))   '这是说在没有时创建菜单“小多”
    
12.         
    
13.         Dim 菜单二 As AcadPopupMenu
    
14.         Set 菜单二 = AddSubMenu(菜单一, 二级菜单名 & Chr(Asc("&")))
    
15.         
    
16.         Dim 菜单三 As AcadPopupMenu
    
17.         Set 菜单三 = AddSubMenu(菜单二, 三级菜单名 & Chr(Asc("&")))
    
18.         
    
19.         Dim subMenuItemPoint As AcadPopupMenuItem
    
20.         If VBA或LSP = "LSP" Then
    
21.             '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令
    
22.             Set subMenuItemPoint = AddMenuItem(菜单三, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")
    
23.         Else
    
24.              Set subMenuItemPoint = AddMenuItem(菜单三, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")
    
25.         End If
    
26.         
    
27.         Dim b As Boolean
    
28.         b = False
    
29.         Dim i As Integer
    
30.         For i = 0 To ThisDrawing.Application.MenuBar.Count - 1
    
31.             If ThisDrawing.Application.MenuBar(i).name = 一级菜单名 & Chr(Asc("&")) Then
    
32.                 b = True
    
33.                 Exit For
    
34.             End If
    
35.         Next
    
36.         If b = False Then
    
37.             菜单一.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
    
38.         End If

Function 创建三级菜单按钮(一级菜单名, 二级菜单名, 三级菜单名, VBA或LSP, 按钮标题, 命令)<br />         'On Error Resume Next<br />         Dim macro As String<br />         macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) '这是在向命令行发送命令时需要的前缀。<br /> <br />         Dim currMenuGroup As AcadMenuGroup<br />         Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)<br /> <br />         '下面是创建菜单“工”<br />         Dim 菜单一 As AcadPopupMenu<br />         Set 菜单一 = AddMenu(currMenuGroup, 一级菜单名 & Chr(Asc("&")))   '这是说在没有时创建菜单“小多”<br />         <br />         Dim 菜单二 As AcadPopupMenu<br />         Set 菜单二 = AddSubMenu(菜单一, 二级菜单名 & Chr(Asc("&")))<br />         <br />         Dim 菜单三 As AcadPopupMenu<br />         Set 菜单三 = AddSubMenu(菜单二, 三级菜单名 & Chr(Asc("&")))<br />         <br />         Dim subMenuItemPoint As AcadPopupMenuItem<br />         If VBA或LSP = "LSP" Then<br />             '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令<br />             Set subMenuItemPoint = AddMenuItem(菜单三, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")<br />         Else<br />              Set subMenuItemPoint = AddMenuItem(菜单三, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")<br />         End If<br />         <br />         Dim b As Boolean<br />         b = False<br />         Dim i As Integer<br />         For i = 0 To ThisDrawing.Application.MenuBar.Count - 1<br />             If ThisDrawing.Application.MenuBar(i).name = 一级菜单名 & Chr(Asc("&")) Then<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             菜单一.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)<br />         End If

这样整个过程就清晰了，对于四级、五级菜单，只要重复调用AddSubMenu函数即可。

清风明月名字

efan2000 发表于 2014-1-14 13:16
创建三个通用函数，简化操作。

最后过程：

Set subMenuItemPoint = 菜单三.SubMenu(i) 上面这一句有错，“subMenuItemPoint”不能获得对象，也就无法删除。所以标题A（其命令为B）一旦创建，则第二次并不能将它改为命令为C，它的命令永远是B。望老师调试改正

efan2000

Set subMenuItemPoint = 菜单三.SubMenu(i)
如果菜单三是AcadPopupMenu对象，那么应该是Set subMenuItemPoint = 菜单三(i)
如果菜单三是AcadPopupMenuItem对象，那么应该是Set subMenuItemPoint = 菜单三.SubMenu(i)