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

  

 

posted @ 2022-03-12 14:18  多见多闻  阅读(231)  评论(0)    收藏  举报