VBA笔记——文本框添加剪切、复制、粘贴、删除快捷键

• 模块代码

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