Nhờ góp ý code để làm menu theo ý muốn. (1 người xem)

vba_gpe · 17/3/11

Mình có tham khảo các bài viết tạo menu của bạn hangdung07 và anh Levanduyet, tuy nhiên kiến thức có hạn nên chỉ làm được sơ sơ chưa theo ý muốn của mình. Post lên nhờ các bạn góp ý.

PHP:

Sub vidu()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCutomMenu As CommandBarControl
 Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
 iHelpMenu = cbMainMenuBar.Controls("Help").Index
 Set cbcCutomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Before:=iHelpMenu)
    cbcCutomMenu.Caption = Cells(1, 1).Value '----------Menu: Chinh
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = Cells(2, 1).Value '----------------Menu: Leve1 (Từ chổ này mình muốn thêm cái nữa nhưng không biết cách)
    End With
 Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
    cbcCutomMenu.Caption = Cells(3, 1).Value'----------Menu: Leve2 
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = Cells(2, 2).Value
    End With
 Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
    cbcCutomMenu.Caption = Cells(2, 3).Value
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = Cells(3, 2).Value
    End With
 End Sub

Mình có gửi file kèm theo. Ý mình như sau:
Main Menu : (Chinh). Trong do co 3 subMenu (Leve1,Leve2,Leve3). Trong mỗi SubMenu này có tương ứng là các menu là ( Leve1.1,...). Các ô này lấy dữ liệu từ cell.
Mình làm mà không theo ý muốn, nhờ các anh chỉnh sửa giúp.
Mong nhận được hồi âm.

Thân mến.

ndu96081631 · 18/3/11

vba_gpe đã viết:
Mình có tham khảo các bài viết tạo menu của bạn hangdung07 và anh Levanduyet, tuy nhiên kiến thức có hạn nên chỉ làm được sơ sơ chưa theo ý muốn của mình. Post lên nhờ các bạn góp ý.

PHP:

Sub vidu() Dim cMenu1 As CommandBarControl Dim cbMainMenuBar As CommandBar Dim iHelpMenu As Integer Dim cbcCutomMenu As CommandBarControl Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") iHelpMenu = cbMainMenuBar.Controls("Help").Index Set cbcCutomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Before:=iHelpMenu) cbcCutomMenu.Caption = Cells(1, 1).Value '----------Menu: Chinh With cbcCutomMenu.Controls.Add(Type:=msoControlButton) .Caption = Cells(2, 1).Value '----------------Menu: Leve1 (Từ chổ này mình muốn thêm cái nữa nhưng không biết cách) End With Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup) cbcCutomMenu.Caption = Cells(3, 1).Value'----------Menu: Leve2 With cbcCutomMenu.Controls.Add(Type:=msoControlButton) .Caption = Cells(2, 2).Value End With Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup) cbcCutomMenu.Caption = Cells(2, 3).Value With cbcCutomMenu.Controls.Add(Type:=msoControlButton) .Caption = Cells(3, 2).Value End With End Sub

Mình có gửi file kèm theo. Ý mình như sau:
Main Menu : (Chinh). Trong do co 3 subMenu (Leve1,Leve2,Leve3). Trong mỗi SubMenu này có tương ứng là các menu là ( Leve1.1,...). Các ô này lấy dữ liệu từ cell.
Mình làm mà không theo ý muốn, nhờ các anh chỉnh sửa giúp.
Mong nhận được hồi âm.

Thân mến.

Thật ra việc tạo menu cũng gần giống với cách tạo Popup Menu thôi... Hổng biết sao bạn lại khai báo chi cả đóng biến rồi Set tùm lum cho cực khổ
Coi tôi làm đây, chẳng có 1 biến nào

PHP:

Sub CreateMenu()
  With Application.CommandBars(1).Controls.Add(10, , , , 0)
    .Caption = Cells(1, 1)
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(2, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(2, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(2, 3)
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(3, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 3)
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(4, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 3)
    End With
  End With
End Sub

Có thể dùng vòng lập để rút gọn code nhưng tôi làm luôn chi tiết cho bạn tiện theo dỏi
Ngoài ra, đã tạo menu thì đương nhiên phải có 2 bước quan trọng:
- Xác định xem menu ấy có tồn tại hay không
- Xóa menu sau khi xong việc
Vậy có thể viết lại code trên cho hoàn chỉnh như sau:

PHP:

Sub DelMenu(ByVal mName As String)
  On Error Resume Next
  Application.CommandBars(1).Controls(mName).Delete
End Sub

PHP:

Sub CreateMenu()
  DelMenu (Cells(1, 1))
  With Application.CommandBars(1).Controls.Add(10, , , , 0)
    .Caption = Cells(1, 1)
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(2, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(2, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(2, 3)
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(3, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 3)
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(4, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 3)
    End With
  End With
End Sub

MinhCong · 18/3/11

Anh cho Em hỏi, trong đoạn code ở trên Em thấy có đoạn DelMenu vậy sao khi ta thoát sheet đó ra, mở sheet khác lên vẫn còn Menu đã tạo trên sheet mới nhỉ?

ndu96081631 · 18/3/11

MinhCong đã viết:
Anh cho Em hỏi, trong đoạn code ở trên Em thấy có đoạn DelMenu vậy sao khi ta thoát sheet đó ra, mở sheet khác lên vẫn còn Menu đã tạo trên sheet mới nhỉ?

Cái DelMenu ấy là tôi viết sẳn ---> Làm gì là việc của bạn... Chẳng hạn bạn có thể đặt vào sự kiện Worksheet_Deactivate hoặc Workbook_Deactivate... để xóa menu

paulsteigel · 18/3/11

Bạn có thể tham khảo một bài viết về tạo menu trong thread này.
http://www.giaiphapexcel.com/forum/...-Menu-đa-lớp-trong-Excel!&p=120461#post120461
Ngoài nhiều cách đã được trình bày trong diễn đàn, tại đây tôi có hướng dẫn cách chi tiết để khởi tạo thực đơn trong Excel.

ndu96081631 · 18/3/11

MinhCong đã viết:
Anh cho Em hỏi, trong đoạn code ở trên Em thấy có đoạn DelMenu vậy sao khi ta thoát sheet đó ra, mở sheet khác lên vẫn còn Menu đã tạo trên sheet mới nhỉ?

Nói thêm 1 chút: Vì cái ta tạo ra là 1 MENU nên có thể xóa bằng lệnh đơn giản:

PHP:

Application.CommandBars("Worksheet Menu bar").Reset

Xem file

vba_gpe · 18/3/11

ndu96081631 đã viết:
Thật ra việc tạo menu cũng gần giống với cách tạo Popup Menu thôi... Hổng biết sao bạn lại khai báo chi cả đóng biến rồi Set tùm lum cho cực khổ
Coi tôi làm đây, chẳng có 1 biến nào

PHP:

Sub CreateMenu() With Application.CommandBars(1).Controls.Add(10, , , , 0) .Caption = Cells(1, 1) With .Controls.Add(10, , , , 0) .Caption = Cells(2, 1) .Controls.Add(1, , , , 0).Caption = Cells(2, 2) .Controls.Add(1, , , , 0).Caption = Cells(2, 3) End With With .Controls.Add(10, , , , 0) .Caption = Cells(3, 1) .Controls.Add(1, , , , 0).Caption = Cells(3, 2) .Controls.Add(1, , , , 0).Caption = Cells(3, 3) End With With .Controls.Add(10, , , , 0) .Caption = Cells(4, 1) .Controls.Add(1, , , , 0).Caption = Cells(4, 2) .Controls.Add(1, , , , 0).Caption = Cells(4, 3) End With End With End Sub

Có thể dùng vòng lập để rút gọn code nhưng tôi làm luôn chi tiết cho bạn tiện theo dỏi
Ngoài ra, đã tạo menu thì đương nhiên phải có 2 bước quan trọng:
- Xác định xem menu ấy có tồn tại hay không
- Xóa menu sau khi xong việc
Vậy có thể viết lại code trên cho hoàn chỉnh như sau:

PHP:

Sub DelMenu(ByVal mName As String) On Error Resume Next Application.CommandBars(1).Controls(mName).Delete End Sub

PHP:

Sub CreateMenu() DelMenu (Cells(1, 1)) With Application.CommandBars(1).Controls.Add(10, , , , 0) .Caption = Cells(1, 1) With .Controls.Add(10, , , , 0) .Caption = Cells(2, 1) .Controls.Add(1, , , , 0).Caption = Cells(2, 2) .Controls.Add(1, , , , 0).Caption = Cells(2, 3) End With With .Controls.Add(10, , , , 0) .Caption = Cells(3, 1) .Controls.Add(1, , , , 0).Caption = Cells(3, 2) .Controls.Add(1, , , , 0).Caption = Cells(3, 3) End With With .Controls.Add(10, , , , 0) .Caption = Cells(4, 1) .Controls.Add(1, , , , 0).Caption = Cells(4, 2) .Controls.Add(1, , , , 0).Caption = Cells(4, 3) End With End With End Sub

Cảm ơn anh nhiều.
Với bài viết trên, mọi thắc mắc của em đã được giải toả.
Thân. /-*+/

vba_gpe · 18/3/11

Lại nhờ bác ndu98081631 xem giúp nhé.
Mình áp dụng code của bác thấy rất Ok. Mình đưa vào một số Macro để chạy thử tuy nhiên thấy câu lệnh mình viết có hơi dài. Chắc là chưa tối ưu. Vì vậy úp lên để nhờ bác và mọi người góp ý giúp mình nhé.

PHP:

Sub CreateMenu()
Dim Menu1, Menu2 As Object
DelMenu (Cells(1, 1))
  With Application.CommandBars(1).Controls.Add(10, , , , 0)
    .Caption = Cells(1, 1)
    With .Controls.Add(msoControlPopup)
      .Caption = Cells(2, 1)
       Set Menu1 = .Controls.Add(msoControlButton)
            With Menu1
                .FaceId = 253
                .OnAction = "thunghiem"
                .Caption = Cells(2, 2)
            End With
      Set Menu2 = .Controls.Add(msoControlButton)
            With Menu2
                .Caption = Cells(2, 3)
                .FaceId = 133
                .OnAction = "thunghiem2"
            End With
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(3, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 3)
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(4, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 3)
    End With
  End With
End Sub
'---------Cai code chay thu Menu--------------------
Sub thunghiem()
    MsgBox ("Ban da thu nghiem thanh cong Menu1.1")
End Sub
Sub thunghiem2()
    MsgBox ("Ban da thu nghiem thanh cong Menu1.2")
End Sub
'---------Cai code deleMenu ------
Sub DelMenu(ByVal mName As String)
  On Error Resume Next
  Application.CommandBars(1).Controls(mName).Delete
End Sub

Thân
Với lại nhờ bác giải thích giúp chổ:

.Controls.Add(1, , , , 0).Caption = Cells(3, 2)

Câu lệnh

PHP:

.Add(1, , , ,0).

ý nghĩa là gì ?
Cảm ơn bác trước nhé.

ndu96081631 · 19/3/11

vba_gpe đã viết:
Lại nhờ bác ndu98081631 xem giúp nhé.
Mình áp dụng code của bác thấy rất Ok. Mình đưa vào một số Macro để chạy thử tuy nhiên thấy câu lệnh mình viết có hơi dài. Chắc là chưa tối ưu. Vì vậy úp lên để nhờ bác và mọi người góp ý giúp mình nhé.

Tôi thì vẫn thích cách dùng With... End With vì khỏi cần đặt biến cho tốn công

PHP:

Sub CreateMenu()
  DelMenu (Cells(1, 1))
  With Application.CommandBars(1).Controls.Add(10, , , , 0)
    .Caption = Cells(1, 1)
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(2, 1)
      With .Controls.Add(1, , , , 0)
        .FaceId = 253
        .OnAction = "thunghiem"
        .Caption = Cells(2, 2)
      End With
      With .Controls.Add(1, , , , 0)
        .Caption = Cells(2, 3)
        .FaceId = 133
        .OnAction = "thunghiem2"
      End With
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(3, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(3, 3)
    End With
    With .Controls.Add(10, , , , 0)
      .Caption = Cells(4, 1)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 2)
      .Controls.Add(1, , , , 0).Caption = Cells(4, 3)
    End With
  End With
End Sub

-----------------------------------------------

vba_gpe đã viết:
Với lại nhờ bác giải thích giúp chổ: Câu lệnh

PHP:

.Add(1, , , ,0).

ý nghĩa là gì ?
Cảm ơn bác trước nhé.

Tôi có giải thích ở đây rồi mà:
http://www.giaiphapexcel.com/forum/...ạo-menu-popup-trong-EXCEL&p=297519#post297519

vba_gpe · 19/3/11

ndu96081631 đã viết:
Tôi thì vẫn thích cách dùng With... End With vì khỏi cần đặt biến cho tốn công

Cảm ơn bác. Đúng là nên học hỏi cách của bác!

ndu96081631 đã viết:
Tôi có giải thích ở đây rồi mà:
http://www.giaiphapexcel.com/forum/showthread.php?46284-T%E1%BA%A1o-menu-popup-trong-EXCEL&p=297519#post297519

Cái này là do mình chưa tìm hiểu kỹ! Bác thông cảm nhé.

Thân

Nhờ góp ý code để làm menu theo ý muốn. (1 người xem)

Người dùng đang xem chủ đề này

vba_gpe

Thành viên thường trực

File đính kèm

ndu96081631

Huyền thoại GPE

File đính kèm

MinhCong

Thành viên gắn bó

ndu96081631

Huyền thoại GPE

paulsteigel

Nhi bất hoặc!

ndu96081631

Huyền thoại GPE

File đính kèm

vba_gpe

Thành viên thường trực

vba_gpe

Thành viên thường trực

File đính kèm

ndu96081631

Huyền thoại GPE

vba_gpe

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.