Thêm command vào chuột phải trên excel

[giaiphapvba]

Chưa đóng góp được gì cho diễn đàn, nên hôm nay em xin chia sẻ bài viết sau. Chắc là nhiều người cũng biết rồi ạ.
Khi click chuột phải trên cells sẽ hiện ra popup lệnh. Trên menu popup này, nếu muốn thêm command lệnh tùy ý, chúng ta làm như sau:

Sub AddMenu()
    Dim Newb
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "TuhocVBA"
        .OnAction = "Sample"
        .BeginGroup = False
    End With
End Sub
Sub Sample()
    MsgBox Now
End Sub

Chạy code thủ tục AddMenu sẽ cho ra kết quả như sau:

Bạn cần đăng nhập để thấy hình ảnh

Khi click vào TuhocVBA thì thủ tục Sample sẽ được thực thi.
Nếu muốn xóa command này đi thì cần chạy thủ tục sau:

Sub DelMenu()
    Application.CommandBars("Cell").Controls("TuhocVBA").Delete
End Sub

 

[dohuuduy]

Bổ ung thêm FaceID để chèn biểu tượng vô menu lệnh nhìn cho ngầu 1 tí

Sub AddMenu()
    Dim Newb
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "TuhocVBA"
        .OnAction = "Sample"
        .BeginGroup = False
        .FaceID = 584
    End With
End Sub
Sub Sample()
    MsgBox Now
End Sub

Mã số ID bạn có thể tham khảo

Bạn cần đăng nhập để thấy link

 

[70211119]

M.n cho e hỏi có cách tạo sub để luân phiên bật/tắt không ạ? Kiểu như có hàm check "nếu" "đã tồn tại" "thì" "off" ngược lại thì "on" ạ. E xin cảm ơn.

 

[tuhocvba]

Bạn cần nêu rõ ràng ý tưởng hơn. Nếu nói như vậy thì không ai giúp được. Nếu có thể, hãy mô hình hóa thay vì dùng chữ.
Học thêm về khai báo biến Public. Trong một topic đang có mức độ tập trung cao độ, tôi không muốn có một bài viết chất lượng thấp như #3 làm loãng chủ đề. Nếu muốn hỏi gì thì vào Box Hỏi Đáp , hoặc Box Thành Viên Tự Giúp Nhau. Liên quan tới topic nào đã có trên diễn đàn thì dẫn link tới.

 

[Euler]

Trên Word:

Option Explicit
Sub CreateMacro()
    Dim MenuButton As CommandBarButton
    With CommandBars("Text")
        Set MenuButton = .Controls.Add(msoControlButton)
        With MenuButton
            .Caption = "Press Me"
'            .Style = msoButtonCaption
            .Style = msoButtonIconAndCaption
            .FaceId = 7
            .OnAction = "Test_Macro"
        End With
    End With
End Sub

Sub Test_Macro()
    MsgBox "I work"
End Sub

Sub ResetRightClick()
    Application.CommandBars("Text").Reset
End Sub

Bạn cần đăng nhập để thấy đính kèm

Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

Bạn cần đăng nhập để thấy link

 

[tuhocvba]

Word:

Option Explicit
Dim oPopUp As CommandBarPopup
Dim oCtr As CommandBarControl

Public Sub BuildControls()
    Dim oBtn As CommandBarButton
  'Make changes to the Add-In template
  'CustomizationContext = ThisDocument.AttachedTemplate
  'Prevent double customization
  Set oPopUp = CommandBars.FindControl(Tag:="custPopup")
  If Not oPopUp Is Nothing Then GoTo Add_Individual
  'Add PopUp menu control to the top of the "Text" short-cut menu
  Set oPopUp = CommandBars("Text").Controls.Add(msoControlPopup, , , 1)
  With oPopUp
   .Caption = "ToolExTest"
   .Tag = "custPopup"
   .BeginGroup = True
  End With
  'Add controls to the PopUp menu
  Set oBtn = oPopUp.Controls.Add(msoControlButton)
  With oBtn
    .Caption = "AnLoiGiai"
    .FaceId = 20
    .Style = msoButtonIconAndCaption
    'Identify the module and procedure to run
    .OnAction = "MySCMacros.RunMyFavMacro"
  End With
  Set oBtn = Nothing
  'Add a Builtin command using ID 1589 (Co&mments)
  'Set oBtn = oPopUp.Controls.Add(msoControlButton, 1589)
  'Set oBtn = Nothing
  'Add the third button
  Set oBtn = oPopUp.Controls.Add(msoControlButton)
  With oBtn
    .Caption = "HienLoiGiai"
    .FaceId = 69
    .Style = msoButtonIconAndCaption
    .OnAction = "MySCMacros.MyInsertAutoText"
  End With
  Set oBtn = Nothing
  Set oBtn = oPopUp.Controls.Add(msoControlButton)
  With oBtn
    .Caption = "XoaLoiGiai"
    .FaceId = 232
    .Style = msoButtonIconAndCaption
    .OnAction = "MySCMacros.MyInsertAutoText"
  End With
  Set oBtn = Nothing
  Set oBtn = oPopUp.Controls.Add(msoControlButton)
  With oBtn
    .Caption = "DanhLaiThuTuCau"
    .FaceId = 11
    .Style = msoButtonIconAndCaption
    .OnAction = "MySCMacros.MyInsertAutoText"
  End With
Add_Individual:
  'Or add individual commands directly to menu
  Set oBtn = CommandBars.FindControl(Tag:="custCmdBtn")
  If Not oBtn Is Nothing Then Exit Sub
  'Add control using built-in ID 758 (Boo&kmarks...)
  Set oBtn = Application.CommandBars("Text").Controls.Add(msoControlButton, 758, , 2)
  oBtn.Tag = "custCmdBtn"
'  If MsgBox("This action caused a change to your Add-In template." _
'     & vbCr + vbCr & "Recommend you save those changes now.", vbInformation + vbOKCancel, _
'     "Save Changes") = vbOK Then
'    ThisDocument.Save
'  End If
  Set oPopUp = Nothing
  Set oBtn = Nothing
lbl_Exit:
  Exit Sub
End Sub

Bạn cần đăng nhập để thấy đính kèm

Bạn cần đăng nhập để thấy link

 

[tuhocvba]

Có cách nào tạo ra các đường kẻ mờ như này không @NhanSu ơi.

Bạn cần đăng nhập để thấy đính kèm

 

[NhanSu]

Mình đang đi vắng nên không test được. Theo mình nhớ thì lệnh .BeginGroup = true để tạo ra đường kẻ ngăn cách.

 

[tuhocvba]

Chuột phải trên Word :
Để tạo menu chuột phải có thể dùng Ribbon. Các bạn tham khảo ở đây:

Bạn cần đăng nhập để thấy link

Về việc tạo menu chuột phải trên Word, như ở

Bạn cần đăng nhập để thấy link

tôi đã đề cập.
Tuy nhiên nếu gặp một bảng Table, các bạn không click chuột phải được.
Chúng ta xem xét lại code trên:

Set oBtn = Application.CommandBars("Text").Controls.Add(msoControlButton, 758, , 2)

Ta sửa lại thành:

Set oBtn = Application.CommandBars("Table Text").Controls.Add(msoControlButton, 758, , 2)

Để reset các bạn chạy code sau:

Private Sub resetX()
    Application.CommandBars("Table Text").Reset
    MsgBox "Xong!"
End Sub

Để tra cứu danh sách CommandBars, các bạn chạy code sau:

Sub ListYourCommandBars()
    For Each c In CommandBars
        Debug.Print c.Name
    Next
End Sub

Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

 

[tuhocvba]

Tham khảo thêm

Bạn cần đăng nhập để thấy link

.

Bạn cần đăng nhập để thấy đính kèm