TẠO MENU NGƯỜI DÙNG TRONG EXCEL doc

TẠO MENU NGƯỜI DÙNG TRONG EXCEL Dành cho người đã biết căn bản Visual Basic For Application Khi bạn tạo một ứng dụng trong excel, để cung cấp việc dễ dàng thao tác cho người dùng bạn ph

TẠO MENU NGƯỜI DÙNG TRONG EXCEL

(Dành cho người đã biết căn bản Visual Basic For Application)

Khi bạn tạo một ứng dụng trong excel, để cung cấp việc dễ dàng thao tác cho người dùng bạn phải tạo một menu riêng Tôi xin giới thiệu cùng các bạn một cách

để tạo menu riêng này

Một menu bao gồm menu cấp 1 (Menu), menu cấp hai (Menu Item), menu cấp ba (Sub Menu Item) Hình 1 dưới đây thể hiện các cấp menu mà tôi vừa nêu trên

Cách giải quyết là menu này được gọi khi một tập tin excel này được mở ra và menu này được gở bỏ khi tập tin excel này được đóng lại

Để cho việc tạo menu này được linh động, tức là bạn có thể thêm bớt, chỉnh sửa dễ dàng thì tôi tạo một bảng dữ liệu nằm trên một sheet làm nguồn cho thủ tục tôi viết

để tạo ra menu Bảng dữ liệu của tôi gồm có 5 cột (Column) đại diện cho 5 trường (field) Các trường cụ thể đó là: Cấp menu (level) như tôi đã giải thích ở trên; Đầu

đề (caption) của cấp menu Các bạn chú ý ở đây 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 giống như hình trên FaceID số nguyên đại diện cho hình biểu diễn của menu đó Để biết được số nguyên nào đại diện cho hình gì bạn có thể download và dùng tập tin add-in faceids.xla

Các dữ liệu trong ví dụ tôi được thể hiện ở hình 2 sau:

Sau đây là các thủ tục để tạo và xoá menu (bạn nên cho vào module) Bạn chú ý tên sheet chứa dữ liệu để tạo menu của bạn có tên là Menusheet

Code:

Sub CreateMenu()

' Thủ tục này thực hiện khi workbook được mở

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

'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Chỉ ra Sheet chứa dữ liệu cho menu

Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")

'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Nhằm chắc chắn Menu không bị trùng

Call DeleteMenu

' Khởi tạo giá trị của hàng đầu tiên

Row = 2

' Thêm vào menu, menu items và submenu items sử dụng

' dữ liệu được lưu 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 ' Menu

' Đưa Menu ở mức cao nhất vào Worksheet CommandBar

Set MenuObject = Application.CommandBars(1) Controls.Add(Type:=msoControlPopup, ?Before:=PositionOrMacro, Temporary:=True)

MenuObject.Caption = Caption

Case 2 ' Menu Item

If NextLevel = 3 Then

Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)

Else

Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)

MenuItem.OnAction = PositionOrMacro

End If

MenuItem.Caption = Caption

If FaceId <> "" Then MenuItem.FaceId = FaceId

If Divider Then MenuItem.BeginGroup = True

Case 3 ' SubMenu Item

Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)

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()

' Thủ tục này sẽ thực hiện khi workbook dược đóng lại

' Xóa Menu

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).Delet e

End If

Row = Row + 1

Loop

On Error GoTo 0

End Sub

Sub DummyMacro() 'Đây chỉ là thủ tục để thử mà thôi

MsgBox "Thu tuc nay khong lam gi ca!"

End Sub

Để tạo và xoá 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