Динамические события выхода элемента управления TextBox в Excel UserForm - PullRequest
Новая
       26

Динамические события выхода элемента управления TextBox в Excel UserForm

1 голос
/ 18 апреля 2019

ОБНОВЛЕНИЕ: После дальнейших исследований в браузере объектов ... кажется, что MSForms.TextBox не реализует ни свойство .Name, ни _Exit события - только _Change события. Есть ли способ определить, какой конкретный TextBox сгенерировал событие изменения?

Альтернативно можно ли использовать MSForms.Control с этой техникой? Объект Control реализует свойство .Name и событие _Exit.

Можете ли вы прослушать событие выхода TextBox? Аналогично тому, как будет работать обычное событие TextBox? Э.Г. 

  Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        'Update a certain label based on the value of the TextBox
  End Sub

Следующее не перехватывает событие выхода. Более того, хотя я вижу свойство .Name объекта TextBox, сгенерировавшего событие для MyTextBox, в окне локальных компьютеров, я не могу получить доступ к этой информации, чтобы определить, на какую метку воздействовать.

Эта методика класса была адаптирована из этого поста и этого поста , который поймал события изменения.

Класс clsTextBox: 

Private WithEvents MyTextBox As MSForms.TextBox

Public Property Set Control(tb As MSForms.TextBox)
    Set MyTextBox = tb
End Property

' Want to handle this event, but it's not caught when exiting the TextBox control
Private Sub MyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    'Debug.Print me.Control.name
    'Update a certain label based on the value of the TextBox
    Stop
End Sub

' Catching this event but can't identify the control which triggered it
Private Sub MyTextBox_Change()
    Debug.Print MyTextBox.Value ' <--- This prints the correct value
    Debug.Print Me.Control.Name ' <--- ERROR here on any variation of Me or MyTextBox
    'Update a certain label based on the value of the TextBox
    Stop
End Sub

У меня есть серия динамически созданных элементов управления, которые нуждаются в слушателях. Код следует: 

  Option Explicit
  Dim tbCollection As Collection

  Private Sub UserForm_Initialize()
        Dim ctrl As MSForms.Control
        Dim obj As clsTextBox
        Dim acftNumber As Long
        Dim mPage As MSForms.MultiPage ' Control
        Dim lbl_acftName As MSForms.Label
        Dim lbl_currentHrs As MSForms.Label
        Dim lbl_hrsDUE As MSForms.Label
        Dim lbl_dateXFRIn As MSForms.Label
        Dim lbl_dateXFROut As MSForms.Label
        Dim lbl_hrsOnXFROut As MSForms.Label
        Dim txb_currentHrs As MSForms.TextBox
        Dim txb_hrsDUE As MSForms.TextBox
        Dim txb_dateXFRIn As MSForms.TextBox
        Dim txb_dateXFROut As MSForms.TextBox
        Dim txb_hrsOnXFROut As MSForms.TextBox
        Dim i As Double
        Dim pgName As String
        Dim acftName As String

        ' Correct for border size calculations bug in Excel 2016
        Me.Height = 249.75
        Me.Width = 350.25

        acftNumber = Range("aircraft").Count 'Unknown value from 3 to 10

        Set mPage = Me.multipage_file_week 'set Multipage variable

        For i = 1 To acftNumber
              'set name/title for new page
              pgName = "pg_acft_" & i
              acftName = Range("aircraft").Cells(i, 1).Value

              'mPage.Pages.Add pgName, pgTitle

              With mPage 'add acft tab
                    ' add the aircraft page to the multipage
                    .Pages.Add pgName, acftName

                    ' Aircraft Name Label
                    Set lbl_acftName = .Pages(i).Controls.Add("Forms.Label.1", "lbl_acftName_" & i, True)
                    With lbl_acftName
                          .Caption = acftName
                          .Font = "Arial"
                          .Font.Size = 12
                          .Font.Bold = True
                          .Left = 10
                          .Width = 55
                          .Top = 0
                    End With

                    ' Current Hours Label and TextBox
                    Set lbl_currentHrs = .Pages(i).Controls.Add("Forms.Label.1", "lbl_currentHrs_" & i, True)
                    With lbl_currentHrs
                          .Caption = "Current Asset Hours:"
                          .TextAlign = fmTextAlignRight
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 20
                          .Width = 120
                          .Top = 25
                    End With
                    Set txb_currentHrs = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_currentHrs_" & i, True)
                    With txb_currentHrs
                          .Value = "16004.5"
                          .Text = "16004.5"
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 150
                          .Width = 70
                          .Top = 25
                    End With


                    ' Hours DUE Label and TextBox
                    Set lbl_hrsDUE = .Pages(i).Controls.Add("Forms.Label.1", "lbl_hrsDUE_" & i, True)
                    With lbl_hrsDUE
                          .Caption = "Hours next HMC DUE:"
                          .TextAlign = fmTextAlignRight
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 20
                          .Width = 120
                          .Top = 50
                    End With
                    Set txb_hrsDUE = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
                    With txb_hrsDUE
                          .Value = "16004.5"
                          .Text = "16004.5"
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 150
                          .Width = 70
                          .Top = 50
                    End With

                    ' Date XFR In Label and TextBox
                    Set lbl_dateXFRIn = .Pages(i).Controls.Add("Forms.Label.1", "lbl_dateXFRIn_" & i, True)
                    With lbl_dateXFRIn
                          .Caption = "Estimated arrival date:"
                          .TextAlign = fmTextAlignRight
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 20
                          .Width = 120
                          .Top = 75
                    End With

                    Set txb_dateXFRIn = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
                    With txb_dateXFRIn
                          .Value = "4/16/2019"
                          .Text = "4/16/2019"
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 150
                          .Width = 70
                          .Top = 75
                    End With


                    ' Date XFR Out Label and TextBox
                    Set lbl_dateXFROut = .Pages(i).Controls.Add("Forms.Label.1", "lbl_dateXFROut_" & i, True)
                    With lbl_dateXFROut
                          .Caption = "Estimated departure date:"
                          .TextAlign = fmTextAlignRight
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 20
                          .Width = 120
                          .Top = 100
                    End With
                    Set txb_dateXFROut = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
                    With txb_dateXFROut
                          .Value = "4/16/2019"
                          .Text = "4/16/2019"
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 150
                          .Width = 70
                          .Top = 100
                    End With

                    ' Hours on XFR Out Label and TextBox
                    Set lbl_hrsOnXFROut = .Pages(i).Controls.Add("Forms.Label.1", "lbl_hrsOnXFROut_" & i, True)
                    With lbl_hrsOnXFROut
                          .Caption = "Desired hours remaining on departure:"
                          .TextAlign = fmTextAlignLeft
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 20
                          .Width = 170
                          .Top = 125
                    End With
                    Set txb_hrsOnXFROut = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
                    With txb_hrsOnXFROut
                          .Value = "35"
                          .Text = "35"
                          .Font = "Arial"
                          .Font.Size = 10
                          .Font.Bold = False
                          .Left = 200
                          .Width = 35
                          .Top = 125
                    End With
              End With

              'Debug
              Debug.Print Me.multipage_file_week.Pages(i).Name & ":"
              For Each ctrl In Me.multipage_file_week.Pages(i).Controls
                    Debug.Print "  - " & ctrl.Name
              Next ctrl

        Next i
        mPage.Value = 0
        Me.Caption = FILE_WEEK_FORM_TITLE

        Set tbCollection = New Collection
        For Each ctrl In Me.Controls
              If TypeOf ctrl Is MSForms.TextBox Then
                    Set obj = New clsTextBox
                    Set obj.Control = ctrl
                    tbCollection.Add obj
              End If
        Next ctrl
        Set obj = Nothing
  End Sub

Ответы [ 2 ]

1 голос
/ 18 апреля 2019

С помощью API ConnectToConnectionPoint вы можете перехватить событие (каждое событие, а также вход и выход) для каждого элемента управления.

Посмотрите здесь: Триггер Введите поведение поля через класс для элемента управления

Для выхода это будет 

Public Sub myExit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute myExit.VB_UserMemId = -2147384829
'code
End Sub
1 голос
/ 18 апреля 2019

MSForms.Control определяет события Enter и Exit: если вам нужно обработать TextBox.Change, тогда вам нужны две WithEvents переменные: 

Private WithEvents TextBoxEvents As MSForms.TextBox
Private WithEvents ControlEvents As MSForms.Control

Public Property Set Control(ByVal tb As Object)
    Set TextBoxEvents = tb
    Set ControlEvents = tb
End Property

MSForms.Control такжеинтерфейс, через который вы получаете доступ к таким свойствам, как Name, Top, Left, Visible и т. д.

Совет. Никогда не вводите сигнатуры процедур обработчика событий вручную.Выберите исходный интерфейс в раскрывающемся списке в верхнем левом углу панели кода, затем выберите событие для обработки в правом верхнем раскрывающемся списке;пусть VBE генерирует членов с правильной подписью.Если вы находитесь в процедуре обработчика, а в верхнем левом раскрывающемся списке указано «(общее)», вы не участвуете в обработчике событий.

РЕДАКТИРОВАТЬ

Хотя приведенный выше кодпрекрасно компилируется, а MSForms.Control интерфейс делает выставление событий, которые мы хотим обработать ... 

?TypeOf tb Is MSForms.Control
True
?TypeOf tb Is MSForms.TextBox
True

... за кулисами происходит немного COM-хакерства;В VBA достаточно дымов и зеркал, чтобы успешно скомпилировать все вышеперечисленное, но, по сути, вы смотрите на сбой в Матрице (у резольвера Rubberduck есть похожие проблемы с "нету" в элементах управления MSForms): очевидного способа получитьVBA для привязки объекта динамического управления к его MSForms.Control событиям.

...