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

清风明月10

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:复件 请求帮助的宏工程.rar 
下载次数:6  文件大小:19.82 KB 
下载权限: 不限 以上  [免费赚D豆]

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

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


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

以上代码已经更新，主要是AddSubMenu之后的对象是AcadPopupMenu，而AcadPopupMenu的Item(i)是AcadPopupMenuItem对象，Item(i).SubMenu才是AcadPopupMenu对象。

efan2000

要先判断一级菜单是否已经创建。

1.         '下面是创建菜单“工”
   
2.         Dim 菜单一 As AcadPopupMenu
   
3.         Dim b As Boolean
   
4.         b = False
   
5.         Dim i As Integer
   
6.         For i = 0 To currMenuGroup.Menus.Count - 1
   
7.             If currMenuGroup.Menus(i).Name = 一级菜单名 & Chr(Asc("&")) Then
   
8.                 b = True
   
9.                 Exit For
   
10.             End If
    
11.         Next
    
12.         If b = False Then
    
13.             Set 菜单一 = currMenuGroup.Menus.Add(一级菜单名 & Chr(Asc("&"))) '这是说在没有时创建菜单“小多”
    
14.         Else
    
15.             Set 菜单一 = currMenuGroup.Menus(一级菜单名 & Chr(Asc("&"))) '这是说在已有菜单“小多”时就让它赋给变量“newMenu”
    
16.         End If

        '下面是创建菜单“工”<br />         Dim 菜单一 As AcadPopupMenu<br />         Dim b As Boolean<br />         b = False<br />         Dim i As Integer<br />         For i = 0 To currMenuGroup.Menus.Count - 1<br />             If currMenuGroup.Menus(i).Name = 一级菜单名 & Chr(Asc("&")) Then<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             Set 菜单一 = currMenuGroup.Menus.Add(一级菜单名 & Chr(Asc("&"))) '这是说在没有时创建菜单“小多”<br />         Else<br />             Set 菜单一 = currMenuGroup.Menus(一级菜单名 & Chr(Asc("&"))) '这是说在已有菜单“小多”时就让它赋给变量“newMenu”<br />         End If

同理判断二、三级菜单是否已经创建，注意是子菜单。

1.         Dim 菜单二 As AcadPopupMenu        b = False
   
2.         For i = 0 To 菜单一.Count - 1
   
3.             If 菜单一(i).Caption = 二级菜单名 & Chr(Asc("&")) Then
   
4.                 Set 菜单二 = 菜单一(i).SubMenu
   
5.                 b = True
   
6.                 Exit For
   
7.             End If
   
8.         Next
   
9.         If b = False Then
   
10.             Set 菜单二 = 菜单一.AddSubMenu(菜单一.Count + 1, 二级菜单名 & Chr(Asc("&")))
    
11.         End If
    
12. 
    
13.         Dim 菜单三 As AcadPopupMenu
    
14.         b = False
    
15.         For i = 0 To 菜单二.Count - 1
    
16.             If 菜单二(i).Caption = 三级菜单名 & Chr(Asc("&")) Then
    
17.                 Set 菜单三 = 菜单二(i).SubMenu
    
18.                 b = True
    
19.                 Exit For
    
20.             End If
    
21.         Next
    
22.         If b = False Then
    
23.             Set 菜单三 = 菜单二.AddSubMenu(菜单二.Count + 1, 三级菜单名 & Chr(Asc("&")))
    
24.         End If

        Dim 菜单二 As AcadPopupMenu        b = False<br />         For i = 0 To 菜单一.Count - 1<br />             If 菜单一(i).Caption = 二级菜单名 & Chr(Asc("&")) Then<br />                 Set 菜单二 = 菜单一(i).SubMenu<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             Set 菜单二 = 菜单一.AddSubMenu(菜单一.Count + 1, 二级菜单名 & Chr(Asc("&")))<br />         End If<br /> <br />         Dim 菜单三 As AcadPopupMenu<br />         b = False<br />         For i = 0 To 菜单二.Count - 1<br />             If 菜单二(i).Caption = 三级菜单名 & Chr(Asc("&")) Then<br />                 Set 菜单三 = 菜单二(i).SubMenu<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             Set 菜单三 = 菜单二.AddSubMenu(菜单二.Count + 1, 三级菜单名 & Chr(Asc("&")))<br />         End If

接下来，如果菜单项已经存在，就删除，然后创建。

1.         Dim subMenuItemPoint As AcadPopupMenuItem        b = False
   
2.         For i = 0 To 菜单三.Count - 1
   
3.             If 菜单三(i).Caption = Chr(Asc("&")) & 按钮标题 Then
   
4.                 Set subMenuItemPoint = 菜单三(i)
   
5.                 subMenuItemPoint.Delete
   
6.                 b = True
   
7.                 Exit For
   
8.             End If
   
9.         Next
   
10. 
    
11.         If VBA或LSP = "LSP" Then
    
12.             '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令
    
13.             Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")
    
14.         Else
    
15.              Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")
    
16.         End If

        Dim subMenuItemPoint As AcadPopupMenuItem        b = False<br />         For i = 0 To 菜单三.Count - 1<br />             If 菜单三(i).Caption = Chr(Asc("&")) & 按钮标题 Then<br />                 Set subMenuItemPoint = 菜单三(i)<br />                 subMenuItemPoint.Delete<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br /> <br />         If VBA或LSP = "LSP" Then<br />             '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令<br />             Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")<br />         Else<br />              Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")<br />         End If

最后判断菜单是否已经在工具栏上了。

1.         b = False
   
2.         For i = 0 To ThisDrawing.Application.MenuBar.Count - 1
   
3.             If ThisDrawing.Application.MenuBar(i).Name = 一级菜单名 & Chr(Asc("&")) Then
   
4.                 b = True
   
5.                 Exit For
   
6.             End If
   
7.         Next
   
8.         If b = False Then
   
9.             菜单一.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
   
10.         End If

        b = False<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

efan2000

完整代码如下：

1. Function 创建三级菜单按钮(一级菜单名, 二级菜单名, 三级菜单名, VBA或LSP, 按钮标题, 命令)        'On Error Resume Next
   
2.         Dim macro As String
   
3.         macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) '这是在向命令行发送命令时需要的前缀。
   
4. 
   
5.         Dim currMenuGroup As AcadMenuGroup
   
6.         Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
   
7. 
   
8.         '下面是创建菜单“工”
   
9.         Dim 菜单一 As AcadPopupMenu
   
10.         Dim b As Boolean
    
11.         b = False
    
12.         Dim i As Integer
    
13.         For i = 0 To currMenuGroup.Menus.Count - 1
    
14.             If currMenuGroup.Menus(i).Name = 一级菜单名 & Chr(Asc("&")) Then
    
15.                 b = True
    
16.                 Exit For
    
17.             End If
    
18.         Next
    
19.         If b = False Then
    
20.             Set 菜单一 = currMenuGroup.Menus.Add(一级菜单名 & Chr(Asc("&"))) '这是说在没有时创建菜单“小多”
    
21.         Else
    
22.             Set 菜单一 = currMenuGroup.Menus(一级菜单名 & Chr(Asc("&"))) '这是说在已有菜单“小多”时就让它赋给变量“newMenu”
    
23.         End If
    
24. 
    
25.         Dim 菜单二 As AcadPopupMenu
    
26.         b = False
    
27.         For i = 0 To 菜单一.Count - 1
    
28.             If 菜单一(i).Caption = 二级菜单名 & Chr(Asc("&")) Then
    
29.                 Set 菜单二 = 菜单一(i).SubMenu
    
30.                 b = True
    
31.                 Exit For
    
32.             End If
    
33.         Next
    
34.         If b = False Then
    
35.             Set 菜单二 = 菜单一.AddSubMenu(菜单一.Count + 1, 二级菜单名 & Chr(Asc("&")))
    
36.         End If
    
37. 
    
38.         Dim 菜单三 As AcadPopupMenu
    
39.         b = False
    
40.         For i = 0 To 菜单二.Count - 1
    
41.             If 菜单二(i).Caption = 三级菜单名 & Chr(Asc("&")) Then
    
42.                 Set 菜单三 = 菜单二(i).SubMenu
    
43.                 b = True
    
44.                 Exit For
    
45.             End If
    
46.         Next
    
47.         If b = False Then
    
48.             Set 菜单三 = 菜单二.AddSubMenu(菜单二.Count + 1, 三级菜单名 & Chr(Asc("&")))
    
49.         End If
    
50. 
    
51.         Dim subMenuItemPoint As AcadPopupMenuItem
    
52.         b = False
    
53.         For i = 0 To 菜单三.Count - 1
    
54.             If 菜单三(i).Caption = Chr(Asc("&")) & 按钮标题 Then
    
55.                 Set subMenuItemPoint = 菜单三.SubMenu(i)
    
56.                 subMenuItemPoint.Delete
    
57.                 b = True
    
58.                 Exit For
    
59.             End If
    
60.         Next
    
61. 
    
62.         If VBA或LSP = "LSP" Then
    
63.             '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令
    
64.             Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")
    
65.         Else
    
66.              Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")
    
67.         End If
    
68. 
    
69.         b = False
    
70.         For i = 0 To ThisDrawing.Application.MenuBar.Count - 1
    
71.             If ThisDrawing.Application.MenuBar(i).Name = 一级菜单名 & Chr(Asc("&")) Then
    
72.                 b = True
    
73.                 Exit For
    
74.             End If
    
75.         Next
    
76.         If b = False Then
    
77.             菜单一.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
    
78.         End If
    
79. End Function

Function 创建三级菜单按钮(一级菜单名, 二级菜单名, 三级菜单名, VBA或LSP, 按钮标题, 命令)        '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 />         Dim b As Boolean<br />         b = False<br />         Dim i As Integer<br />         For i = 0 To currMenuGroup.Menus.Count - 1<br />             If currMenuGroup.Menus(i).Name = 一级菜单名 & Chr(Asc("&")) Then<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             Set 菜单一 = currMenuGroup.Menus.Add(一级菜单名 & Chr(Asc("&"))) '这是说在没有时创建菜单“小多”<br />         Else<br />             Set 菜单一 = currMenuGroup.Menus(一级菜单名 & Chr(Asc("&"))) '这是说在已有菜单“小多”时就让它赋给变量“newMenu”<br />         End If<br /> <br />         Dim 菜单二 As AcadPopupMenu<br />         b = False<br />         For i = 0 To 菜单一.Count - 1<br />             If 菜单一(i).Caption = 二级菜单名 & Chr(Asc("&")) Then<br />                 Set 菜单二 = 菜单一(i).SubMenu<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             Set 菜单二 = 菜单一.AddSubMenu(菜单一.Count + 1, 二级菜单名 & Chr(Asc("&")))<br />         End If<br /> <br />         Dim 菜单三 As AcadPopupMenu<br />         b = False<br />         For i = 0 To 菜单二.Count - 1<br />             If 菜单二(i).Caption = 三级菜单名 & Chr(Asc("&")) Then<br />                 Set 菜单三 = 菜单二(i).SubMenu<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br />         If b = False Then<br />             Set 菜单三 = 菜单二.AddSubMenu(菜单二.Count + 1, 三级菜单名 & Chr(Asc("&")))<br />         End If<br /> <br />         Dim subMenuItemPoint As AcadPopupMenuItem<br />         b = False<br />         For i = 0 To 菜单三.Count - 1<br />             If 菜单三(i).Caption = Chr(Asc("&")) & 按钮标题 Then<br />                 Set subMenuItemPoint = 菜单三.SubMenu(i)<br />                 subMenuItemPoint.Delete<br />                 b = True<br />                 Exit For<br />             End If<br />         Next<br /> <br />         If VBA或LSP = "LSP" Then<br />             '创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令<br />             Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & 命令 & " ")<br />         Else<br />              Set subMenuItemPoint = 菜单三.AddMenuItem(菜单三.Count + 1, Chr(Asc("&")) & 按钮标题, macro & "-VBARUN " & 命令 & " ")<br />         End If<br /> <br />         b = False<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<br /> End Function

学编程当中，尽量少使用On Error Resume Next，它会屏蔽错误，难以发现问题所在。

清风明月10

efan2000 发表于 2014-1-21 17:22
完整代码如下：

调试后，里面有点BUG，我改了，再贴实际运行的代码在此。

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
        Dim b As Boolean
        b = False
        Dim i As Integer
        For i = 0 To currMenuGroup.Menus.Count - 1
            If currMenuGroup.Menus(i).Name = 一级菜单名 & Chr(Asc("&")) Then
                b = True
                Exit For
            End If
        Next
        If b = False Then
            Set 菜单一 = currMenuGroup.Menus.Add(一级菜单名 & Chr(Asc("&"))) '这是说在没有时创建菜单“小多”
        Else
            Set 菜单一 = currMenuGroup.Menus(一级菜单名 & Chr(Asc("&"))) '这是说在已有菜单“小多”时就让它赋给变量“newMenu”
        End If

        Dim 菜单二 As AcadPopupMenu
        b = False
        For i = 0 To 菜单一.Count - 1
            If 菜单一(i).Caption = 二级菜单名 & Chr(Asc("&")) Then
                Set 菜单二 = 菜单一(i).SubMenu
                b = True
                Exit For
            End If
        Next
        If b = False Then
            Set 菜单二 = 菜单一.AddSubMenu(菜单一.Count + 1, 二级菜单名 & Chr(Asc("&")))
        End If

        Dim 菜单三 As AcadPopupMenu
        b = False
        For i = 0 To 菜单二.Count - 1
            If 菜单二(i).Caption = 三级菜单名 & Chr(Asc("&")) Then
            Set 菜单三 = 菜单二(i).SubMenu
                b = True
                 Exit For
            End If
        Next
        If b = False Then
            Set 菜单三 = 菜单二.AddSubMenu(菜单二.Count + 1, 三级菜单名 & Chr(Asc("&")))
        End If

        Dim subMenuItemPoint As AcadPopupMenuItem
        b = False
        For i = 0 To 菜单三.Count - 1
            If 菜单三(i).Caption = Chr(Asc("&")) & 按钮标题 Then
                Set subMenuItemPoint = 菜单三.SubMenu(i)
                subMenuItemPoint.Delete
                b = True
                Exit For
            End If
        Next

        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

        b = False
        For i = 0 To ThisDrawing.Application.MenuBar.Count - 1
            If ThisDrawing.Application.MenuBar(i).Name = 一级菜单名 & Chr(Asc("&")) Then
                b = True
                Exit For
            End If
        Next
        If b = False Then
            菜单一.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
        End If
End Function

清风明月10

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:调试用的宏工程.zip 
下载次数:0  文件大小:33.54 KB 
下载权限: 不限 以上  [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:调试用的宏工程.zip 
下载次数:0  文件大小:33.54 KB 
下载权限: 不限 以上  [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:调试用的宏工程.zip 
下载次数:0  文件大小:33.54 KB 
下载权限: 不限 以上  [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:调试用的宏工程.zip 
下载次数:0  文件大小:33.54 KB 
下载权限: 不限 以上  [免费赚D豆]

efan2000 发表于 2014-1-21 17:22
完整代码如下：

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

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:调度用的宏工程.zip 
下载次数:0  文件大小:33.54 KB 
下载权限: 不限 以上  [免费赚D豆]

efan2000

在菜单“工具”-“选项”里，打开选项对话框，将错误捕获，发生错误则中断，就知道在哪里错误了，调试也方便。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:调度用的宏工程.zip 
下载次数:0  文件大小:33.78 KB 
下载权限: 不限 以上  [免费赚D豆]