''''启用复制、粘贴、删除等功能
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")
If cb.Name = "ShortCut" Then
Application.CommandBars("ShortCut").Delete
End If
Next
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 GoTo toexit
Application.CommandBars("ShortCut").Delete
toexit: Exit Sub
End Sub
注意:vb调用动态的dll,如果报错是没法用On Error GoTo line 的
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
'每次要销毁
For Each cb In Application.CommandBarsIf cb.Name = "ShortCut" Then
Application.CommandBars("ShortCut").Delete
End If
Next
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 GoTo toexit
Application.CommandBars("ShortCut").Delete
toexit: Exit Sub
End Sub