Hệ thống trình đơn (menu) giúp người dùng nhanh chóng và dễ dàng truy cập các tính năng của ứng dụng. Menu của Word và Excel đã quá quen thuộc với chúng ta, có khi nào bạn nghĩ đến việc thêm menu của riêng mình vào hệ thống menu đã có sẵn để thực hiện những công việc nào đó chưa? Dưới đây xin giới thiệu cùng các bạn một cách để tạo menu riêng trong Excel với VBA (Visual Basic for Applications). Menu này được tạo khi tập tin Excel được mở ra và được gỡ bỏ khi tập tin Excel này được đóng lại.
Một menu thông thường có 3 cấp như hình 1. Để cho việc tạo menu được linh động, có thể thêm bớt, chỉnh sửa dễ dàng, tôi tạo một bảng dữ liệu nằm trên một sheet làm nguồn cho các khoản mục của menu. Bảng dữ liệu gồm có 5 cột đại diện cho 5 trường (field): cấp menu (level); đầu đề (caption) của cấp menu (lưu ý ký tự '&' đứng trước ký tự nào trong đầu đề thì ký tự đó sẽ được gạch dưới - phím nóng); vị trí hay tên macro cần thực hiện (position/macro), vị trí đối với menu cấp một, tên macro cần thực hiện đối với menu cấp hai hay cấp ba; lằn ngăn cách (divider), nếu bạn cho bằng true thì trước menu đó sẽ có lằn ngăn cách; FaceID - số đại diện cho hình biểu diễn của menu, để biết được số nào đại diện cho hình gì bạn có thể dùng add-in faceids.xla (http://www.j-walk.com/ss/excel/tips/faceidgrid.exe).
Các dữ liệu trong ví dụ tôi được thể hiện ở hình 2.
Sau đây là các thủ tục để tạo và xóa menu (bạn nên cho vào module). Bạn chú ý tên sheet chứa dữ liệu để tạo menu có tên là MenuSheet.
|
|
Sub CreateMenu()
‘ Thu tuc nay thuc hien khi workbook duoc mo.
‘
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’
‘ Chi ra Sheet chua du lieu cho menu
Set MenuSheet = ThisWorkbook.Sheets(“MenuSheet”)
‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’
‘ Nham chac chan menu khong bi trung
Call DeleteMenu
‘ Khoi tao gia tri cua hang dau tien
Row = 2
‘ Them vao menus, menu items va submenu items su dung
‘ du lieu duoc luu trong MenuSheet
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With
Select Case MenuLevel
Case 1 ‘ A Menu
‘ Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1)._
Controls.Add(Type:=msoControlPopup,_
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
Case 2 ‘ A Menu Item
If NextLevel = 3 Then
Set MenuItem = MenuObject.Controls.Add(Type:=mso ControlPopup)
Else
Set MenuItem = MenuObject.Controls.Add(Type:=mso ControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId <> “” Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True
Case 3 ‘ A SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add(Type:=mso ControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> “” Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End Sub
Sub DeleteMenu()
‘ Thu tuc nay se thuc hien khi workbook duoc dong lai
‘ Xoa Menus
Dim MenuSheet As Worksheet
Dim Row As Integer
Dim Caption As String
On Error Resume Next
Set MenuSheet = ThisWorkbook.Sheets(“MenuSheet”)
Row = 2
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
If MenuSheet.Cells(Row, 1) = 1 Then
Caption = MenuSheet.Cells(Row, 2)
Application.CommandBars(1).Controls (Caption).Delete
End If
Row = Row + 1
Loop
On Error GoTo 0
End Sub
Sub DummyMacro()
MsgBox “This is a do-nothing macro.”
End Sub
Để tạo và xóa menu bạn gọi các thủ tục trên khi sự kiện Open và BeforeClose xảy ra.
Private Sub Workbook_Open()
Call CreateMenu
MsgBox “A new menu (MyMenu) was created.”, vbInformation
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleteMenu
End Sub
Hy vọng bài viết trên sẽ giúp ích cho các bạn. Mọi góp ý xin gởi theo địa chỉ email.
levanduyet@yahoo.com