VB правой кнопкой мыши копировать / вставить в многостраничном - PullRequest
0 голосов
/ 06 июля 2018

Позвольте мне предвосхитить мой вопрос тем фактом, что я самоучка, поэтому, пожалуйста, предоставьте как можно больше подробностей и имейте меня, если вы хотите, чтобы вы объяснили по-разному или несколько раз.

Я создал инструмент создания нотаций / электронных писем для своей команды, используя Microsoft Visual Basic 7.0. Единственная жалоба, которую я получил по этому поводу, заключалась в том, что многие из них не используются для горячих клавиш, поэтому они зависят от использования мыши, но щелчок правой кнопкой мыши не работает. Мне удалось найти код, который создает всплывающее окно для копирования и вставки, когда они используют щелчок правой кнопкой мыши, и он отлично работает на нескольких текстовых полях, которые находятся в самой главной форме, однако он не работает на большинстве текстовых полей, так как они в многостраничном.

Кто-нибудь знает, как изменить приведенный ниже код для работы с текстовыми полями на многостраничной странице? Кроме того, до того, как это было предложено, я решил поиграть с многостраничной продукцией, однако этот формат является самым простым, поскольку есть несколько этапов и типов заметок / электронных писем, которые им нужно будет отправлять в любое время, поэтому вкладки, доступные им для простого нажатия, являются наиболее удобными для пользователя, которые я смог создать и с которыми они все согласились.

Заранее всем большое спасибо!

Код по форме:

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

Код в модуле класса:

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 Ответ

0 голосов
/ 06 июля 2018

Получить имя ActiveControl для многостраничного элемента управления

Необходимо знать выбранный многостраничный Page через вспомогательную функцию (ActiveControlName), используя свойство SelectedItem и получая оттуда элемент управления (его имя). Измените события нажатия кнопки следующим образом:

Соответствующие события нажатия кнопки в модуле класса 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

Вспомогательная функция, вызываемая вышеуказанными событиями клика

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

Примечание

Рекомендуется проверить длину выделенных текстовых строк в случае пустых строк, чтобы предотвратить нежелательные результаты.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...