工具栏→下拉菜单的工作方法

ningyong58

http://club.excelhome.net/thread-631687-1-1.html
小结了一下其要点为：
1 Set 工具列 = Application.CommandBars.Add(Name:=工具列名稱, Position:=msoBarTop, Temporary:=True)
2 Set 按鈕 = 工具列.Controls.Add(Type:=msoControlButton, Temporary:=True)
3  Set 新功能表按鈕 = 工具列.Controls.Add(Type:=msoControlPopup, Temporary:=True)

调试了几次总是有问题。
目标需求，将附件示例再简化一下，工具栏中三个按钮→1按钮，这个按钮有下拉菜单。

ningyong58

Position:=msoBarTop, Temporary:=True→好理解。
Type:=msoControlButton, Temporary:=True→基本理解
Type:=msoControlPopup, Temporary:=True→这个弯转不过来

如何定义msoControlButton赋值→msoControlPopup的赋值关系。

请各位大侠解决的问题见图

看原程序没问题，自己重做一遍，一个小弯老是拐不过来。



Book1.rar (7.27 KB, 下载次数: 30)

2010-9-30 15:10 上传

点击文件名下载附件

[ 本帖最后由 ningyong58 于 2010-9-30 15:57 编辑 ]

fsyyyy

弹出式控件

lb_bn

没有2003的excel，调试不了，给楼主一个4级菜单的，看有没有帮助。

lb_bn

我的理解就是msoControlPopup型的包含msoControlButton型的，前者是后者的父级。

ningyong58

原帖由 lb_bn 于 2010-9-30 20:21 发表
我的理解就是msoControlPopup型的包含msoControlButton型的，前者是后者的父级。

谢谢，使用的示例都是 as object.
看了这个帖子思路逐渐清晰。msoControlPopup型的包含msoControlButton型
''''

1. Dim myPop As CommandBarPopup
   
2.     Dim myBtn As CommandBarButton
   
3.     Dim Pop() As CommandBarPopup
   
4.     Dim Pop1() As CommandBarPopup
   
5. 
   
6. Sub ls()
   
7.   On Error Resume Next
   
8.   
   
9.     Dim i As Long
   
10.     CommandBars("tempBar").Delete
    
11.     Dim oBar As CommandBar
    
12.     Set oBar = Application.CommandBars.Add("tempBar", msoBarPopup, , True)
    
13.     With oBar
    
14.       .Height = 500
    
15.       .Width = 400
    
16.       .Visible = True
    
17.       
    
18.     End With
    
19.     ''
    
20.     Dim oPop As CommandBarPopup
    
21.     Dim oBtn As CommandBarButton
    
22.     Dim Pop() As CommandBarPopup
    
23.     Dim Pop1() As CommandBarPopup
    
24.     ''
    
25.     Set oPop = oBar.Controls.Add(msoControlPopup, , , , True) '  oBar.Controls.Add(msoControlPopup, , , , True)
    
26.     With oPop
    
27.       .Caption = "寺ffffffffff"
    
28.       .Visible = True
    
29.     End With
    
30.     ReDim Pop(0)
    
31.     Set Pop(0) = oPop.Controls.Add(msoControlPopup, , , , True)
    
32.     With Pop(0)
    
33.       .Caption = "fdafdaf"
    
34.       .Visible = True
    
35.     End With
    
36.     'CommandBars("tempBar").ShowPopup
    
37. End Sub
    
38. ''
    
39. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
40.   Dim oBar As CommandBarButton
    
41.   CommandBars("tempBar").ShowPopup
    
42. End Sub

复制代码

Book1.rar (6.86 KB, 下载次数: 66)

2010-10-2 11:16 上传

点击文件名下载附件

[ 本帖最后由 ningyong58 于 2010-10-2 11:16 编辑 ]

ningyong58

Set myPop = mybar.Controls.Add(msoControlPopup, , , , True)
                myPop.Caption = .Cells(i, "A")

比这种写法理解起来容易点。
Set 新功能表按鈕 = 工具列.Controls.Add(Type:=msoControlPopup, Temporary:=True)

1. Sub Create_popup()
   
2.     On Error Resume Next
   
3.     'Dim i As Byte
   
4.     Dim i As Long
   
5.     CommandBars("myR").Delete
   
6.     Dim mybar As CommandBar
   
7.     Set mybar = Application.CommandBars.Add("myR", msoBarPopup, , True)
   
8.         mybar.Height = 500
   
9.         mybar.Width = 400
   
10.         
    
11.     Dim myPop As CommandBarPopup
    
12.     Dim myBtn As CommandBarButton
    
13.     Dim Pop() As CommandBarPopup
    
14.     Dim Pop1() As CommandBarPopup
    
15.     Dim n As Integer
    
16.     Dim n1 As Integer
    
17.     n = 1
    
18.     n1 = 1
    
19.     Dim dc As Object
    
20.     Dim dc1 As Object
    
21.     Set dc = CreateObject("scripting.dictionary")
    
22.     Set dc1 = CreateObject("scripting.dictionary")
    
23.    
    
24.     With Sheets("商品名称数源")
    
25.         For i = 1 To .[a65536].End(3).Row
    
26.         'For i = 2 To .[a65536].End(3).Row
    
27.         Next
    
28.         For i = 1 To .[a65536].End(3).Row
    
29.         'For i = 2 To .[a65536].End(3).Row
    
30.             If .Cells(i, "A").Font.ColorIndex = 3 Then
    
31.                 Set myPop = mybar.Controls.Add(msoControlPopup, , , , True)
    
32.                 myPop.Caption = .Cells(i, "A")
    
33.                 bl = True
    
34.             Else
    
35.                 If .Cells(i, "D") <> "" Then
    
36.                     If Not dc.exists(.Cells(i, "D").Value) Then
    
37.                         dc.Add .Cells(i, "D").Value, n
    
38.                         ReDim Preserve Pop(n) As CommandBarPopup
    
39.                         Set Pop(n) = myPop.Controls.Add(msoControlPopup, , , , True)
    
40.                         Pop(n).Caption = .Cells(i, "D")
    
41.                         n = n + 1
    
42.                     End If 'If Not dc.exists(.Cells(i, "D").Value)
    
43.                   
    
44.                     If .Cells(i, "E") <> "" Then
    
45.                         If Not dc1.exists(.Cells(i, "E").Value) Then
    
46.                             dc1.Add .Cells(i, "E").Value, n1
    
47.                             ReDim Preserve Pop1(n1) As CommandBarPopup
    
48.                             Set Pop1(n1) = Pop(dc.Item(.Cells(i, "D").Value)).Controls.Add(msoControlPopup, , , , True)
    
49.                             Pop1(n1).Caption = .Cells(i, "E")
    
50.                             n1 = n1 + 1
    
51.                         End If
    
52.                         Set myBtn = Pop1(dc1.Item(.Cells(i, "E").Value)).Controls.Add(msoControlButton)
    
53.                         myBtn.Caption = .Cells(i, "A")
    
54.                         myBtn.HelpFile = .Cells(i, 2) & "," & .Cells(i, 3)
    
55.                         myBtn.Style = msoButtonCaption
    
56.                         myBtn.OnAction = "myBtn_click"
    
57.                     Else
    
58.                     
    
59.                         Set myBtn = Pop(dc.Item(.Cells(i, "D").Value)).Controls.Add(msoControlButton)
    
60.                         myBtn.Caption = .Cells(i, "A")
    
61.                         myBtn.HelpFile = .Cells(i, 2) & "," & .Cells(i, 3)   '2010年5月5日：将单价和单位信息保存到按钮的Helpfile属性中，然后在mybtn_click事件中取出。
    
62.                         myBtn.Style = msoButtonCaption
    
63.                         myBtn.OnAction = "myBtn_click"
    
64.                     End If
    
65.    
    
66.                 Else
    
67.                     Set myBtn = myPop.Controls.Add(msoControlButton)
    
68.                     myBtn.Caption = .Cells(i, "A")
    
69.                     myBtn.HelpFile = .Cells(i, 2) & "," & .Cells(i, 3)   '2010年5月5日：将单价和单位信息保存到按钮的Helpfile属性中，然后在mybtn_click事件中取出。
    
70.                     myBtn.Style = msoButtonCaption
    
71.                     myBtn.OnAction = "myBtn_click"
    
72.                 End If  'If .Cells(i, "D") <> "" Then
    
73.             End If  'If .Cells(i, "A").Font.ColorIndex = 3 Then
    
74.         Next
    
75.     End With
    
76.    
    
77.     Set myBtn = Nothing
    
78.     Set myPop = Nothing
    
79.     Set mybar = Nothing
    
80.     Set dc = Nothing
    
81.     Set dc1 = Nothing
    
82.     Erase Pop
    
83.     Erase Pop1
    
84. End Sub

复制代码

[ 本帖最后由 ningyong58 于 2010-10-2 10:23 编辑 ]

linyancheng

Set 按鈕 = 新功能表按鈕.CommandBar.Controls.Add(Type:=msoControlButton, Temporary:=True)

我的代碼紅色部分不加不行，為什麼你們可以不用加？

是變數宣告類型不同的關係嗎？

[ 本帖最后由 linyancheng 于 2010-10-2 18:58 编辑 ]

ningyong58

1. Sub aaa()
   
2. 
   
3.     On Error Resume Next
   
4.    
   
5.     Dim X As Long
   
6.     Dim btnArr As Variant
   
7.     Dim oBar As Object
   
8.     Dim newBtn As Object
   
9.     Dim Btn As Object
   
10.     Dim toolName As String
    
11.    
    
12.     '編輯區，其他部分不須編輯==================================================================================================
    
13.     '◎表Btn置於oBar上，否則置於新功能表上
    
14.     '★表新功能表銨鈕
    
15.     '▲表Btn開始群組，可單獨使用，否則必須緊接在◎、★之後
    
16.     '非◎者一定要置於★項目之後
    
17.     '陣列元素名稱須為Sub名稱（★項目除外）
    
18.    
    
19.     btnArr = Array("◎VBA1", "★VBA2", "VBA3", "▲VBA4", "◎▲VBA5", "★▲VBA6", "VBA7", "VBA8", "▲VBA9")
    
20.    
    
21.     toolName = "myTool"
    
22.     Application.CommandBars(toolName).Delete
    
23.     '==================================================================================================
    
24.    
    
25.     Set oBar = Application.CommandBars.Add(Name:=toolName, Position:=msoBarTop, Temporary:=True)
    
26.    
    
27.     oBar.Visible = True
    
28.    
    
29.     For X = 0 To UBound(btnArr)
    
30.         If Left(btnArr(X), 1) = "◎" Then
    
31.             Set Btn = oBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    
32.             
    
33.             With Btn
    
34.                 .Caption = Replace(btnArr(X), "◎", "")
    
35.                 .Caption = Replace(.Caption, "▲", "")
    
36.                 .Caption = Replace(.Caption, "Show", "")
    
37.                 .Style = msoButtonCaption
    
38.                 .OnAction = Replace(btnArr(X), "◎", "")
    
39.                 .OnAction = Replace(.OnAction, "▲", "")
    
40.                
    
41.                 If Not InStr(Left(btnArr(X), 2), "▲") = 0 Then
    
42.                     .BeginGroup = True
    
43.                 End If
    
44.             End With
    
45.         ElseIf Left(btnArr(X), 1) = "★" Then
    
46.             Set newBtn = oBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
    
47.             
    
48.             With newBtn
    
49.                 .Caption = Replace(btnArr(X), "★", "")
    
50.                 .Caption = Replace(.Caption, "▲", "")
    
51.                 .Style = msoButtonCaption
    
52.                
    
53.                 If Not InStr(Left(btnArr(X), 2), "▲") = 0 Then
    
54.                     .BeginGroup = True
    
55.                 End If
    
56.             End With
    
57.         Else
    
58.             Set Btn = newBtn.CommandBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    
59.             
    
60.             With Btn
    
61.                 .Caption = Replace(btnArr(X), "▲", "")
    
62.                 .Caption = Replace(.Caption, "Show", "")
    
63.                 .Style = msoButtonCaption
    
64.                 .OnAction = Replace(btnArr(X), "▲", "")
    
65.                
    
66.                 If Not InStr(Left(btnArr(X), 2), "▲") = 0 Then
    
67.                     .BeginGroup = True
    
68.                 End If
    
69.             End With
    
70.         End If
    
71.     Next X
    
72. 
    
73. End Sub

复制代码

[ 本帖最后由 ningyong58 于 2010-10-4 08:24 编辑 ]