vba 调用系统复制剪切功能

''''启用复制、粘贴、删除等功能

注意：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.CommandBars

       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