如何修改此模块类以使用userforms和工作表对象?

时间:2017-11-09 17:52:20

标签: excel vba excel-vba

我正在开发一个正在被很多用户使用的Excel文档,其中一些不是技术专家。我遇到了这段代码,试图在文本框中启用右键单击上下文菜单进行复制和粘贴。它在用户表单中完美地工作,但是,我的工作表上有文本框,需要右键单击上下文菜单。是否可以对类或初始化进行任何更改以允许此代码在工作表上工作?谢谢!

课程模块代码:

'Popup objects
Private cmdBar As CommandBar
Private WithEvents cmdCopyButton As CommandBarButton
Private WithEvents cmdPasteButton As CommandBarButton

'Useform to use
Private fmUserform As Object


'Control array of textbox
Private colControls As Collection

'Textbox Control
Private WithEvents tbControl As MSForms.TextBox
'Adds all the textbox in the userform to use the popup bar
Sub Initialize(ByVal UF As Object)
   Dim Ctl As MSForms.Control
   Dim cBar As clsBar
   For Each Ctl In UF.Controls
      If TypeName(Ctl) = "TextBox" Then

         'Check if we have initialized the control array
        If colControls Is Nothing Then
            Set colControls = New Collection
            Set fmUserform = UF

            'Create the popup
           CreateBar
         End If

         'Create a new instance of this class for each textbox
        Set cBar = New clsBar
         cBar.AssignControl Ctl, cmdBar
         'Add it to the control array
        colControls.Add cBar
      End If
   Next Ctl
End Sub

Private Sub Class_Terminate()
   'Delete the commandbar when the class is destroyed
  On Error Resume Next
   cmdBar.Delete
End Sub

'Click event of the copy button
Private Sub cmdCopyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   fmUserform.ActiveControl.Copy
   CancelDefault = True
End Sub

'Click event of the paste button
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   fmUserform.ActiveControl.Paste
   CancelDefault = True
End Sub

'Right click event of each textbox
Private Sub tbControl_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
      ByVal X As Single, ByVal Y As Single)

   If Button = 2 And Shift = 0 Then
      'Display the popup
     cmdBar.ShowPopup
   End If
End Sub

Private Sub CreateBar()
   Set cmdBar = Application.CommandBars.Add(, msoBarPopup, False, True)
   'We’ll use the builtin Copy and Paste controls
  Set cmdCopyButton = cmdBar.Controls.Add(ID:=19)
   Set cmdPasteButton = cmdBar.Controls.Add(ID:=22)
End Sub

'Assigns the Textbox and the CommandBar to this instance of the class
Sub AssignControl(TB As MSForms.TextBox, Bar As CommandBar)
   Set tbControl = TB
   Set cmdBar = Bar
End Sub

Userform代码:

 Dim cBar As clsBar

Private Sub UserForm_Initialize()
   Set cBar = New clsBar
   cBar.Initialize Me
End Sub

0 个答案:

没有答案