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

Chia sẻ: Nguyen Quy | Ngày: | Loại File: PDF | Số trang:7

Thêm vào BST

Báo xấu

111
lượt xem 32
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

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

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: Lập trình với menus và toolbars

Lập trình với menus và toolbars Menu Pop-Up 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: Code: Option Explicit Public Const gc_Title = "PopUp Menu Demo" Public gcBar_RgtClkMenu As CommandBar ' ************************************************** *************************
' Muc dich: Gọi hàm tạo popup menu người dùng ' Sub RunMeToGetThingsGoing() Set gcBar_RgtClkMenu = CreateSubMenu End Sub ' ************************************************** ************************* ' Hàm tạo popup menu ' Function CreateSubMenu() As CommandBar 'đặt tên cho popup menu Const lcon_PuName = "PopUpDemo" 'Tạo các đối tượng cho cho popup menu Dim cb As CommandBar Dim cbc As CommandBarControl
'Chắc chắn rằng popup menu không tồn tại DeleteCommandBar lcon_PuName 'Thêm popup menu người dùng cho tập họp (collection) CommandBars Set cb = CommandBars.Add(Name:=lcon_PuName, Position:=msoBarPopup, MenuBar:=False, Temporary:=False) '------------------------------ ' Thêm vào controls Set cbc = cb.Controls.Add With cbc .Caption = "&Control 1" .OnAction = "DummyMessage" End With Set cbc = cb.Controls.Add With cbc .Caption = "Control &2"
.OnAction = "DummyMessage" End With '------------------------------ Set CreateSubMenu = cb End Function ' ************************************************** ************************* ' Mục đích: Kiểm tra nếu command bar có tên menuName? ' Nếu tồn tại thì xóa đi ' Sub DeleteCommandBar(menuName) Dim mb For Each mb In CommandBars If mb.Name = menuName Then CommandBars(menuName).Delete
End If Next End Sub Sub DummyMessage() MsgBox "Hello", vbInformation + vbOKOnly, gc_Title End Sub Đây là đoạn mã trong worksheet module: workhere Option 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, Cancel As Boolean) On Error GoTo Worksheet_BeforeRightClick_Error
'Hiện popup menu người dùng gcBar_RgtClkMenu.ShowPopup Worksheet_BeforeRightClick_Resume: 'Nhằm ngăn chặn popup menu mặc định của Excel Cancel = True 'Thoát khỏi thủ tục Exit Sub Worksheet_BeforeRightClick_Error: 'Nếu macro khởi tạo chưa chạy 'Hỏ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) Then 'Nếu người dùng click "Yes", thì chạy
RunMeToGetThingsGoing MsgBox "Bây giờ thử lại", vbInformation + vbOKOnly, gc_Title End If ''Thoát Resume Worksheet_BeforeRightClick_Resume End Sub