Trigger Enter field behaviour through class for a control

后端 未结 3 1065
一向
一向 2020-12-12 00:30

I raised a query which now works as per David Zemens\' instructions and BrakNicku guidance.

Problem is one of the events I want to use is Enter. Wit

相关标签:
3条回答
  • 2020-12-12 00:54

    Here another solution, (doesnot work on a MAC)

    Open Notepad and copy code below and paste it in a new txt-file save it als CatchEvents.cls

    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
    END
    Attribute VB_Name = "CatchEvents"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Private Type GUID
          Data1 As Long
          Data2 As Integer
          Data3 As Integer
          Data4(0 To 7) As Byte
    End Type
    
    #If VBA7 And Win64 Then
          Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, _
                  ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, _
                  Optional ByVal ppcpOut As LongPtr) As Long
    #Else
         Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, _
                  ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
    #End If
    
    Private EventGuide As GUID
    Private Ck As Long
    Private ctl As Object
    'All Other Control-Events also possible
    Public Sub MyEnter()
    Attribute MyEnter.VB_UserMemId = -2147384830
      Select Case TypeName(ctl)
      Case "TextBox": MsgBox "Your code for " & ctl.Name & " here!"
      Case Else: MsgBox "You entered no TextBox but another control (" & ctl.Name & ")!"
      End Select
    End Sub
    
    Public Sub ConnectAllEvents(ByVal Connect As Boolean)
          With EventGuide
              .Data1 = &H20400
              .Data4(0) = &HC0
              .Data4(7) = &H46
          End With
          ConnectToConnectionPoint Me, EventGuide, Connect, ctl, Ck, 0&
    End Sub
    
    Public Property Let Item(Ctrl As Object)
          Set ctl = Ctrl
          Call ConnectAllEvents(True)
    End Property
    
    Public Sub Clear()
          If (Ck <> 0) Then Call ConnectAllEvents(False)
          Set ctl = Nothing
    End Sub
    

    In your VBA editor you import this File

    In your Userform code you add:(when you have already an Initialize-event you combine those)

    Private AllControls() As New CatchEvents 'on top
    
    Private Sub UserForm_Initialize()
    ReDim AllControls(Controls.Count - 1)
        For j = 0 To Controls.Count - 1
            AllControls(j).Item = Controls(j)
        Next
    End Sub
    

    Now every Enter-event of any control will be catched, so you have to act accordingly. Every event on a Userform can be catched this way.

    0 讨论(0)
  • Let's say your userform (Userform1) looks like this

    I am going to demonstrate the Enter Event for 2 controls. TextBox and ComboBox.

    Ensure that you place the CommandButton1 first on the userform. Or alternatively, set it's TabIndex to 0. This is so that the command button takes focus first when the userform loads and you can test the Entering of TextBox and ComboBox.

    Paste this in a class module. My Class module name is Class1

    Option Explicit
    
    Public WithEvents Usrfrm As UserForm1
    Const MyMsg As String = "Hiya there. Did you just try to sneak into the "
    
    Private Sub Usrfrm_OnEnter(ctrl As msforms.Control)
        Select Case True
            Case TypeName(ctrl) Like "ComboBox"
                'Call Usrfrm.Combobox_List(ctrl)
                MsgBox MyMsg & "combobox?", vbCritical, "Aha!"
            Case TypeName(ctrl) Like "TextBox"
                MsgBox MyMsg & "textbox?", vbCritical, "Aha!"
        End Select
    End Sub
    

    Paste this in the userform code area

    Option Explicit
    
    Public Event OnEnter(ctrl As msforms.Control)
    Private prevCtl As msforms.Control
    Private mycls As Class1
    Private IsfrmUnloaded As Boolean
    
    Private Sub CommandButton1_Click()
        Unload Me
    End Sub
    
    Private Sub UserForm_Layout()
        Call spyWhatsGoingOn
    End Sub
    
    Private Sub spyWhatsGoingOn()
        Set mycls = New Class1
        Set mycls.Usrfrm = Me
    
        IsfrmUnloaded = False
    
        Set prevCtl = Me.ActiveControl
    
        RaiseEvent OnEnter(Me.ActiveControl)
    
        Do While IsfrmUnloaded = False
            If Not prevCtl Is Nothing Then
                If Not prevCtl Is Me.ActiveControl Then
                    RaiseEvent OnEnter(Me.ActiveControl)
                    Me.ActiveControl.SetFocus
                End If
            End If
            Set prevCtl = Me.ActiveControl
            DoEvents
        Loop
    End Sub
    

    Demo

    0 讨论(0)
  • 2020-12-12 01:10

    So the approach I went with was: I already had Class Module that was trapping Change event (can be seen here). As i didnt have access to Enter event in my class, I used the KeyUp and MouseDown events in this class to set help for each control. This way user can get to a field by clicking on it or tabbing to it: help is displayed for the selected control

    0 讨论(0)
提交回复
热议问题