Lập trình với menus và toolbars

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
Nội dung trích xuất từ tài liệu:
Lập trình với menus và toolbars Lập trình với menus và toolbarsMenu Pop-UpMục đích: Tạo menu popup khi người dùng Right-Click khi chuột trong vùng làmviệ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ằmtrong module worksheet: workhereĐây là đoạn mã trong module VBA PopupMenu:Code:Option ExplicitPublic Const gc_Title = PopUp Menu DemoPublic gcBar_RgtClkMenu As CommandBar *************************************************************************** Muc dich: 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 cho popup menuConst lcon_PuName = PopUpDemoTạo các đối tượng cho 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 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 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 *************************************************************************** Muc đích : Nó sẽ được kích họat khi người dùng Right click ***************************************************************************Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, CancelAs 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ông?If vbYes = MsgBox(You need to run the macro _& RunMeToGetThingsGoing _& before this demo will work & vbCrLf _& vbCrLf & Run it now?, vbQuestion + vbYesNo, gc_Title) ThenNếu người dùng click Yes, thì chạyRunMeToGetThingsGoingMsgBox Bây giờ thử lại, vbInformation + vbOKOnly, gc_TitleEnd IfThoátResume Worksheet_BeforeRightClick_ResumeEnd Sub