VB right click copy/paste in multipage

2019-05-10 01:04发布

Let me preface my question with the fact that I am self taught, so please provide as much detail as possible and bear with me if I need you to explain differently or multiple times.

I created a notation/email generating tool for my team using Microsoft Visual Basic 7.0. The only complaint that I received on it was that many of them are not used to hot keys so they depend on using the mouse but right click didn't work. I was able to find code that creates a pop-up for copy and paste when they use right click, and it works great on the few textboxes that are on the main form itself, however it does not work on the majority of the textboxes as they are in a Multipage.

Does anyone know how to alter the below code to work for textboxes on a Multipage? Also, before it is suggested, I did toy with the idea of moving everything out of the Multipage, however that format is the easiest as there are multiple stages and types of notes/emails that they would need to send at any time, so having tabs available for them to simply click is the most user friendly that I was able to create and that they all agreed on.

Thank you all so much in advance!

Code in the form:

Dim cBar As clsBar

Private Sub UserForm_Initialize()

    On Error GoTo Whoa
    Application.EnableEvents = False

    Set cBar = New clsBar
    cBar.Initialize Me

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue

End Sub

Code in a Class Module:

Option Explicit

'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

1条回答
虎瘦雄心在
2楼-- · 2019-05-10 01:24

Get ActiveControl name on a Multipage control

It's necessary to know the multipage's selected Page via a helper function (ActiveControlName) using SelectedItem property and getting the control (its name) from there. Change your button click events as follows:

Relevant button click events in class module clsBar

'Click event of the copy button
Private Sub cmdCopyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim sACN As String
sACN = ActiveControlName(fmUserform)    ' find control's name
       ' Debug.Print sACN & ".Copy"
fmUserform.Controls(sACN).Copy          ' << instead of 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)
Dim sACN As String
sACN = ActiveControlName(fmUserform)
       ' Debug.Print sACN & ".Paste"
fmUserform.Controls(sACN).Paste    ' << instead of fmUserform.ActiveControl.Paste
CancelDefault = True
End Sub

Helper function called by above click events

Function ActiveControlName(form As UserForm) As String
'cf Site: https://stackoverflow.com/questions/47745663/get-activecontrol-inside-multipage
'Purpose: get ActiveControl
 Dim MyMultiPage As MSForms.MultiPage, myPage As MSForms.Page
 If form.ActiveControl Is Nothing Then
    ' do nothing
 ElseIf TypeName(form.ActiveControl) = "MultiPage" Then
    Set MyMultiPage = form.ActiveControl
    Set myPage = MyMultiPage.SelectedItem
    ActiveControlName = myPage.ActiveControl.Name
 Else
    ActiveControlName = form.ActiveControl.Name
 End If
 End Function

Side note

Suggest to check for the length of selected text strings in case of empty strings to prevent from unwanted results.

查看更多
登录 后发表回答