[UserForm]Tạo menu chuột phải cho TextBox trên UserForm

tuhocvba

Administrator
Thành viên BQT
Trên sheet ta có thao tác chuột phải như Copy, Delete, Cut, Select All...
Vậy mà ô TextBox trên UserForm thì lại không có chức năng chuột phải này.
Vì vậy, ở topic này tôi sẽ hướng dẫn các bạn hiện thực hóa điều đó.
Bạn cần đăng nhập để thấy đính kèm


Trên UserForm bạn tạo một ô TextBox.
Code cho UserForm là:
UserForm:
Private Sub UserForm_Initialize()
  Static dcp As New CRightClick
  dcp.Initialize Me
End Sub
Tiếp theo bạn tạo một Class có tên là: CRightClick
Code cho class này là:
CRightClick:
Public WithEvents Tb As MSForms.TextBox
Public WithEvents Cb As MSForms.ComboBox
Private WithEvents BCut  As Office.CommandBarButton
Private WithEvents BCopy As Office.CommandBarButton
Private WithEvents BPaste As Office.CommandBarButton
Private WithEvents BDelete As Office.CommandBarButton
Private WithEvents BAll As Office.CommandBarButton
Dim dbox As Collection

Private Sub BAll_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  Dim bx As Object
  If TypeName(Tb) = "TextBox" Then Set bx = Tb Else Set bx = Cb
  With bx
    .SelStart = 0
    .SelLength = Len(.Value)
  End With
End Sub
Private Sub BCopy_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  If TypeName(Tb) = "TextBox" Then Tb.Copy Else Cb.Copy
End Sub
Private Sub BCut_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  If TypeName(Tb) = "TextBox" Then Tb.Cut Else Cb.Cut
End Sub
Private Sub BDelete_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  If TypeName(Tb) = "TextBox" Then Tb.SelText = "" Else Cb.SelText = ""
End Sub
Private Sub BPaste_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  If TypeName(Tb) = "TextBox" Then Tb.Paste Else Cb.Paste
End Sub

Private Sub Cb_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  If Button = 2 And Cb.Style = fmStyleDropDownCombo Then pCopyPaste Cb
End Sub
Private Sub Tb_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  If Button = 2 Then pCopyPaste Tb
End Sub

Sub Initialize(fm As Object)
  Dim cc As CRightClick, bx As Object
  On Error Resume Next
  Set dbox = New Collection
  For Each bx In fm.Controls
    Select Case TypeName(bx)
    Case "TextBox", "ComboBox"
      Set cc = New CRightClick
      If TypeName(bx) = "TextBox" Then Set cc.Tb = bx Else Set cc.Cb = bx
      dbox.Add cc
    End Select
  Next
End Sub
Private Sub pCopyPaste(bx As Object) 'Copy&Paste Menu click chuot phai
  With Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True)
    Set BCut = .Controls.Add(msoControlButton)
    With BCut
      .Caption = "Cut(&T)"
      .FaceId = 21
      .Enabled = bx.SelLength
      If bx.Locked Then .Enabled = False
    End With
    Set BCopy = .Controls.Add(msoControlButton)
    With BCopy
      .Caption = "Copy(&C)"
      .FaceId = 19
      .Enabled = bx.SelLength
    End With
    Set BPaste = .Controls.Add(msoControlButton)
    With BPaste
      .Caption = "Paste(&P)"
      .FaceId = 22
      .Enabled = bx.CanPaste
    End With
    Set BDelete = .Controls.Add(msoControlButton)
    With BDelete
      .Caption = "Delete(&D)"
      .FaceId = 47
      .Enabled = bx.SelLength
      .BeginGroup = True
    End With
    Set BAll = .Controls.Add(msoControlButton)
    With BAll
      .Caption = "Select All(&A)"
      .Enabled = Len(bx.Value)
    End With
    .ShowPopup
    .Delete
  End With
End Sub
Tôi không cung cấp file demo vì hướng dẫn trên là đầy đủ rồi. Các bạn thử làm xem sao nhé.
Nguồn tham khảo:
 

PTHhn

Yêu THVBA như điếu đổ
Code của bên Andypope viết có vẻ dễ đọc hơn.
Bạn cần đăng nhập để thấy hình ảnh


File demo của họ:
 
Top