• Thứ Ba, 16/12/2003 15:04 (GMT+7)

    Tạo menu trong Excel

    Lượt xem 7846
    Đánh giá


    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

    ID: A0301_90
    Ý kiến của bạn? Ý kiến của bạn?
    Tin ngày :

Thuật ngữ