Private ActiveTB As MSForms.TextBox
Public Sub CreateShortCutMenu()
Dim ShortCutMenu As CommandBar
Dim ShortCutMenuItem As CommandBarButton
Dim sCaption As Variant
Dim iFaceId As Variant
Dim sAction As Variant
Dim i As Integer
sCaption = Array("剪切(&C)", "复制(&T)", "贴粘(&P)", "删除(&D)")
iFaceId = Array(21, 19, 22, 1786)
sAction = Array("Action_Cut", "Action_Copy", "Action_Paste", "Action_Delete")
On Error Resume Next
Application.CommandBars("ShortCut").Delete
Set ShortCutMenu = Application.CommandBars.Add("ShortCut", msoBarPopup)
With ShortCutMenu
For i = 0 To 3
Set ShortCutMenuItem = .Controls.Add(msoControlButton)
With ShortCutMenuItem
.Caption = sCaption(i)
.FaceId = Val(iFaceId(i))
.OnAction = sAction(i)
End With
Next
End With
End Sub
Public Sub ShowPopupMenu(txtCtr As MSForms.TextBox)
Dim Action As Variant
Set ActiveTB = txtCtr
With Application.CommandBars("ShortCut")
.Controls(1).Enabled = txtCtr.SelLength > 0
.Controls(2).Enabled = .Controls(1).Enabled
.Controls(3).Enabled = txtCtr.CanPaste
.Controls(4).Enabled = .Controls(1).Enabled
.ShowPopup
End With
End Sub
Public Sub Action_Cut()
ActiveTB.Cut
End Sub
Public Sub Action_Copy()
ActiveTB.Copy
End Sub
Public Sub Action_Paste()
ActiveTB.Paste
End Sub
Public Sub Action_Delete()
Dim s As String
With ActiveTB
s = .SelText
.Value = Replace(.Value, s, "")
End With
End Sub
Public Sub DeleteShortCutMenu()
On Error Resume Next
Application.CommandBars("ShortCut").Delete
End Sub
Private Sub UserForm_Initialize()
Call CreateShortCutMenu
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then ShowPopupMenu ActiveControl
End Sub
Private Sub TextBox2_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then ShowPopupMenu ActiveControl
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call DeleteShortCutMenu
End Sub