Tạo menu popup trong EXCEL

Tạo menu popup khi người dùng Right-Click khi chuột trong vùng làm việc của một worksheet. Giả sử workbook của tôi có một worksheet, thì trong ví dụ của tôi có hai đoạn mã. Đoạn thứ nhất nằm trong Module VBA: PopupMenu và đoạn mã thứ hai nằm trong module worksheet: workhere • Đây là đoạn mã trong module VBA PopupMenu: Option Explicit Public Const gc_Title = "PopUp Menu Demo" Public gcBar_RgtClkMenu As CommandBar *************************************************************************** Mục đích : Gọi hàm để tạo popup menu người dùng Sub RunMeToGetThingsGoing() Set gcBar_RgtClkMenu = CreateSubMenu End Sub *************************************************************************** ...
Nội dung trích xuất từ tài liệu:
Tạo menu popup trong EXCEL Tạo menu popup trong EXCEL Mục đích: Tạo menu popup khi người dùng Right-Click khi chuột trong vùng làm việc của một worksheet. Giả sử workbook của tôi có một worksheet, thì trong ví dụ của tôi có hai đoạn mã. Đoạn thứ nhất nằm trong Module VBA: PopupMenu và đoạn mã thứ hai nằm trong module worksheet: workhere• Đây là đoạn mã trong module VBA PopupMenu:Option ExplicitPublic Const gc_Title = PopUp Menu DemoPublic gcBar_RgtClkMenu As CommandBar *************************************************************************** Mục đích : Gọi hàm để tạo popup menu người dùngSub RunMeToGetThingsGoing()Set gcBar_RgtClkMenu = CreateSubMenuEnd Sub *************************************************************************** Hàm để tạo popup menuFunction CreateSubMenu() As CommandBarĐặt tên chopopup menuConst lcon_PuName = PopUpDemoTạo các đối tượng cho popup menuDim cb As CommandBarDim cbc As CommandBarControlChắc chắn rằng popup menu không tồn tạiDeleteCommandBar lcon_PuNameThêm popup menu người dùng cho tập họp (collection) CommandBarsSet cb = CommandBars.Add(Name:=lcon_PuName, Position:=msoBarPopup, MenuBar:=False,Temporary:=False) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Thêm vào thử một số controlsSet cbc = cb.Controls.AddWith cbc.Caption = &Control 1.OnAction = DummyMessageEnd WithSet cbc = cb.Controls.AddWith cbc.Caption = Control &2.OnAction = DummyMessageEnd With - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Set CreateSubMenu = cbEnd Function *************************************************************************** Mục đích : Kiểm tra nếu command bar có tên menuName Nếu nó tồn tại thì xóa điSub DeleteCommandBar(menuName)Dim mbFor Each mb In CommandBarsIf mb.Name = menuName ThenCommandBars(menuName).DeleteEnd IfNextEnd SubSub DummyMessage()MsgBox Hello, vbInformation + vbOKOnly, gc_TitleEnd Sub • Đây là đoạn mã trong worksheet module: workhereOption Explicit *************************************************************************** Mục đích : Nó sẽ được kích hoạt khi người dùng right clickPrivate Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)On Error GoTo Worksheet_BeforeRightClick_ErrorHiện popup menu người dùnggcBar_RgtClkMenu.ShowPopupWorksheet_BeforeRightClick_Resume:Nhằm ngăn chặn popup menu mặc định của ExcelCancel = TrueThoát khỏi thủ tụcExit SubWorksheet_BeforeRightClick_Error:Nếu macro khởi tạo chưa chạyHỏi người dùng có muốn chạy bây giờ khôngIf vbYes = MsgBox(You need to run the macro RunMeToGetThingsGoing before thisdemo will work _& vbCrLf & vbCrLf & Run it now?, vbQuestion + vbYesNo, gc_Title) ThenUser clicked Yes, so run itRunMeToGetThingsGoingMsgBox Now try again, vbInformation + vbOKOnly, gc_TitleEnd IfThoátResume Worksheet_BeforeRightClick_ResumeEnd SubLần đầu khi bạn Right Click thì bạn sẽ nhận được thông báo sau:Sau đó nếu bạn chọn Yes thì bạn sẽ nhận được thông báo sau:Cuối cùng bạn thử Right Click lại thì bạn sẽ nhận được popup menu sau:Chúc các bạn thành công. Hy vọng bài viết trên sẽ giúp ích các bạn phần nào.