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 đó.
Trên UserForm bạn tạo một ô TextBox.
Code cho UserForm là:
Tiếp theo bạn tạo một Class có tên là: CRightClick
Code cho class này là:
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:
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
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
Nguồn tham khảo:
Bạn cần đăng nhập để thấy link