关于vb封装弹出式三级菜单问题，请老师指正，究竟哪里出错

hefeilac

此部分代码借用论坛上的，在此感谢原创老师
附件为excel格式，并可正常执行 求助.zip (56.4 KB, 下载次数: 4)

2017-4-24 15:19 上传

点击文件名下载附件

现在我用VB封装后总是弹出

貌似WriteToRng过程出现了问题
我的VB封装代码如下，请老师指正，不胜感激！
我在过程中call main是可以显示弹出式菜单，只有最后输出到表格时出错！

1. Public xlapp As Excel.Application
   
2. Dim Tree
   
3. Sub Main()
   
4.     Dim mybar As Object, arr, i&, j&, key$, myb, pkey$
   
5.     Dim N_col As Long
   
6.     Dim wb As Workbook
   
7.      On Error Resume Next
   
8.      Set wb = GetObject(App.Path & "\紧固件三级选单.xls")
   
9.      Set Tree = CreateObject("Scripting.Dictionary")
   
10.      xlapp.CommandBars("myCell").Delete
    
11.      Set mybar = xlapp.CommandBars.Add(Name:="myCell", Position:=msoBarPopup)
    
12.      Tree.Add "myCell", mybar
    
13.      arr = wb.Worksheets("sheet1").Range("a1").CurrentRegion.Value
    
14.      N_col = UBound(arr, 2)
    
15.      ReDim Preserve arr(1 To UBound(arr, 1), 1 To N_col + 1)
    
16.      For j = 2 To UBound(arr, 1)
    
17.          If Not Tree.Exists(arr(j, 1)) Then
    
18.              If arr(j, 2) = "" Then
    
19.                  AddControlButton "myCell", arr(j, 1), arr(j, 1), j, N_col
    
20.              Else
    
21.                  AddControlPopup "myCell", arr(j, 1), arr(j, 1)
    
22.              End If
    
23.          End If
    
24.      Next
    
25.      For i = 2 To UBound(arr)
    
26.          key = arr(i, 1)
    
27.          For j = 2 To N_col
    
28.              If arr(i, j) <> "" Then
    
29.                  pkey = key
    
30.                  key = key & "" & arr(i, j)
    
31.                  If arr(i, j + 1) = "" Then
    
32.                      AddControlButton pkey, key, arr(i, j), i, N_col
    
33.                  Else
    
34.                      If Not Tree.Exists(key) Then
    
35.                          AddControlPopup pkey, key, arr(i, j)
    
36.                      End If
    
37.                  End If
    
38.              End If
    
39.          Next
    
40.      Next
    
41.      wb.Close False
    
42.      Set wb = Nothing
    
43.      Set mybar = Nothing
    
44. End Sub
    
45. Private Sub AddControlButton(ByVal pkey$, ByVal key$, ByVal caption$, ByVal i&, ByVal n&)
    
46.     Dim myb
    
47.      Set myb = Tree(pkey).Controls.Add(Type:=msoControlButton)
    
48.      With myb
    
49.          .caption = caption
    
50.          .OnAction = "'WriteToRng " & i & "," & n & "'"
    
51.      End With
    
52.      Tree.Add key, myb
    
53. End Sub
    
54. Private Sub AddControlPopup(ByVal pkey$, ByVal key$, ByVal caption$)
    
55.     Dim myb
    
56.      Set myb = Tree(pkey).Controls.Add(Type:=msoControlPopup)
    
57.      myb.caption = caption
    
58.      Tree.Add key, myb
    
59. End Sub
    
60. Public Sub WriteToRng(i, N_col)   '写入单元格
    
61. xlapp.ScreenUpdating = False
    
62.   Dim wb As Workbook
    
63.    Set wb = GetObject(App.Path & "\紧固件三级选单.xls")
    
64.    Set sh = wb.Worksheets("sheet1")
    
65.       xlapp.ActiveCell = sh.Cells(i, N_col).Value
    
66.     wb.Close
    
67.    Set wb = Nothing
    
68. xlapp.ScreenUpdating = True
    
69. End Sub

复制代码

17362279485

你好:现在问题解决了么? 我也遇到了这个问题?

vitrel

OnAction后的WriteToRng子过程，必须置于模块中才能被正常调用，
以上信息不知对楼主是否有用，就当是意见参考吧，其他的我也了解得不多。