随笔- 567 文章- 0 评论- 0 阅读- 55万

VBA多级菜单

Sub GOINMYSUB()
MsgBox "成功进入我的过程！！"
End Sub
 
Sub MyMenu()
   Dim Popup(5)
   Dim Button(5) As CommandBarControl
    
   On Error Resume Next
   DeleteOldDMenu                    '单清除旧菜
    
   ' 建立新菜單
   Set Popup(0) = Application.CommandBars.Add("MyVAB", Position:=msoBarTop)
   Popup(0).Visible = True
  
   Lastrow = Range("E65536").End(xlUp).Row
   I = 2
    
   Do While I <= Lastrow
       
      For K = 1 To 3
       If Cells(I, K) <> Empty Then
         Popup(K + 1) = Empty        '清空有关数据
         Popup(K + 2) = Empty
         Exit For
        End If
      Next
      If Cells(I, 5) = Empty Then      ' 建立子菜單
         Set Popup(K) = Popup(K - 1).Controls.Add(Type:=msoControlPopup, Temporary:=True) '
         Popup(K).Caption = Cells(I, K).Text
      Else                             ' 建立按钮快键
         Set Button(K) = Popup(K - 1).Controls.Add(Type:=msoControlButton, Temporary:=True)
         Button(K).Caption = Cells(I, K).Text
         Button(K).FaceId = Cells(I, 4)
         Button(K).OnAction = Cells(I, 5).Text
      End If
      I = I + 1
   Loop
 
End Sub
 
 
Sub DeleteOldDMenu()
   On Error Resume Next
   Application.CommandBars("MyVAB").Delete
    
End Sub