发布时间 : 星期一 文章Excel VBA_多级动态数据有效性设置实例集锦更新完毕开始阅读
k2 = D2(k(i) & k1(j)).Keys
ReDim Preserve Pop(j) As CommandBarPopup
Set Pop(j) = .Controls.Add(msoControlPopup, , , , True) Pop(j).Caption = k1(j) For x = 0 To UBound(k2)
k3 = D3(k(i) & k1(j) & k2(x)).Keys
ReDim Preserve Pop1(x) As CommandBarPopup
Set Pop1(x) = Pop(j).Controls.Add(msoControlPopup, , , , True) Pop1(x).Caption = k2(x) For y = 0 To UBound(k3)
Set myBtn = Pop1(x).Controls.Add(msoControlButton) With myBtn
.Caption = k3(y)
.HelpFile = k(i) & \ .OnAction = \输入\ .FaceId = 70 + y End With Next Next Next End With Next
.ShowPopup '显示工具栏 End With
Application.CommandBars(\临时菜单\删除工具栏 ‘Application.ScreenUpdating = True End Sub
15，4级动态数据有效性（快捷菜单
CommandBarPopup）
‘http://club.excelhome.net/thread-719328-1-1.html ‘’点击单元格自动弹出的4级菜单.xls
‘Thisworkbook中代码： Private Sub Workbook_Open() Call Create_popup End Sub
‘Sheet1中代码：
Private Sub Worksheet_Change(ByVal Target As Range) Call Create_popup End Sub
‘Sheet2中代码：
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Column <> 2 Then Exit Sub
If Target.Row > 11 Or Target.Row < 4 Then Exit Sub
CommandBars(\ ‘屏蔽单元格右键快捷菜单。使得在本例里面左右键都可显示自定义快捷菜单 Call showMybar End Sub
Sub showMybar()
CommandBars(\ ‘显示自定义快捷菜单 End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) CommandBars(\ If Target.Count > 1 Then Exit Sub If Target.Column <> 2 Then Exit Sub
If Target.Row > 11 Or Target.Row < 4 Then Exit Sub Call showMybar End Sub
‘模块1中代码： Sub myBtn_click()
Dim cc As CommandBarButton
Set cc = Application.CommandBars.ActionControl ActiveCell = cc.Caption
Dim arr '用数组在helpfile属性中取出单价和单位 arr = Split(cc.HelpFile, \ ActiveCell.Offset(, 1) = arr(0)
ActiveCell.Offset(, 3) = arr(1) '然后放入相应的单元格 End Sub
Sub Create_popup()
On Error Resume Next Dim i As Long
CommandBars(\ Dim mybar As CommandBar
Set mybar = Application.CommandBars.Add(\
mybar.Height = 500 mybar.Width = 400
Dim myPop As CommandBarPopup Dim myBtn As CommandBarButton Dim Pop() As CommandBarPopup Dim Pop1() As CommandBarPopup Dim n As Integer Dim n1 As Integer n = 1 n1 = 1
Dim dc As Object Dim dc1 As Object
Set dc = CreateObject(\ Set dc1 = CreateObject(\
With Sheets(\商品名称数源\
For i = 1 To .[a65536].End(3).Row
If .Cells(i, \
Set myPop = mybar.Controls.Add(msoControlPopup, , , , True) myPop.Caption = .Cells(i, \ bl = True Else
If .Cells(i, \
If Not dc.exists(.Cells(i, \ dc.Add .Cells(i, \
ReDim Preserve Pop(n) As CommandBarPopup
Set Pop(n) = myPop.Controls.Add(msoControlPopup, , , , True) Pop(n).Caption = .Cells(i, \ n = n + 1 End If
If .Cells(i, \
If Not dc1.exists(.Cells(i, \ dc1.Add .Cells(i, \
ReDim Preserve Pop1(n1) As CommandBarPopup Set Pop1(n1) = Pop(dc.Item(.Cells(i, \
Pop1(n1).Caption = .Cells(i, \ n1 = n1 + 1 End If Set myBtn = Pop1(dc1.Item(.Cells(i, \
myBtn.Caption = .Cells(i, \
myBtn.HelpFile = .Cells(i, 2) & \ myBtn.Style = msoButtonCaption myBtn.OnAction = \ Else
Set myBtn = Pop(dc.Item(.Cells(i, \
myBtn.Caption = .Cells(i, \
myBtn.HelpFile = .Cells(i, 2) & \ '将单价和单位信息保存到按钮的Helpfile属性中，然后在mybtn_click事件中取出。 myBtn.Style = msoButtonCaption myBtn.OnAction = \ End If
Else
Set myBtn = myPop.Controls.Add(msoControlButton) myBtn.Caption = .Cells(i, \
myBtn.HelpFile = .Cells(i, 2) & \ '将单价和单位信息保存到按钮的Helpfile属性中，然后在mybtn_click事件中取出。 myBtn.Style = msoButtonCaption myBtn.OnAction = \ End If End If Next End With
Set myBtn = Nothing Set myPop = Nothing Set mybar = Nothing Set dc = Nothing Set dc1 = Nothing Erase Pop Erase Pop1 End Sub
摘自帮助文档：
本示例创建包含剪切、复制和粘贴按钮（控件）的自定义编辑工具栏。
Dim customBar As CommandBar
Dim newButton As CommandBarButton
Set customBar = CommandBars.Add(\Set newButton = customBar.Controls _