api捕获事件,如何作用于窗体中的textbox控件?

ndt3

因业务需要在窗体中动态创建了50+的textbox,每次退出文本框时需要校核输入内容等工作.创建类模块无法使用exit事件,

目前找到替代方法,使用api来获取控件事件,在工作表中可以使用,但如何作用于窗体,求教各位大神!十分感谢!
原贴代码如下:

excel - 使用 VBA 和 ActiveX 减少 WithEvent 声明和 subs

最佳答案

打开记事本并复制下面的代码并将其粘贴到新的 txt 文件中另存为 CatchEvents2.cls

    VERSION 1.0 CLASS    BEGIN      MultiUse = -1  'True    END    Attribute VB_Name = "CatchEvents2"    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    Private CustomProp As String    Public Sub MyChange()    Attribute MyChange.VB_UserMemId = 2    Debug.Print " Change ControlName " & " Type: " & TypeName(ctl) & " CustomProp: " & CustomProp    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 Prop(newProp As String)          CustomProp = newProp    End Property    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
在您的 VBA 编辑器中导入此文件(右键单击您的 VBA 项目并选择导入)

在普通模块中，您输入以下代码:
Private AllControls() As New CatchEvents2Sub connect()Dim j As LongWith Worksheets("Sheet1")ReDim AllControls(.OLEObjects.Count - 1)    For j = 0 To .OLEObjects.Count - 1       AllControls(j).Item = .OLEObjects(j + 1).Object       AllControls(j).Prop = .OLEObjects(j + 1).Name    NextEnd WithEnd SubSub disconnect()Dim j As Long  For j = LBound(AllControls) To UBound(AllControls)          AllControls(j).Clear   Next j      Erase AllControlsEnd Sub
现在，当您运行 connect sub 时，任何 activeX 控件的每个更改都会被捕获

编辑:在评论后放入所有其他事件；
其他事件:(所有这些也适用于用户表单)
Public Sub MyChange()Attribute MyChange.VB_UserMemId = 2Debug.Print "ch"End SubPublic Sub MyListClick()Attribute MyListClick.VB_UserMemId = -610Debug.Print "cl1"End SubPublic Sub MyClick()Attribute MyClick.VB_UserMemId = -600Debug.Print "cl2"End SubPublic Sub myKeyPress(ByVal KeyAscii As MSForms.ReturnInteger)Attribute myKeyPress.VB_UserMemId = -603Debug.Print "kp"End Sub
然后有 4 个(用户窗体)事件:Exit、Enter、AfterUpdate 和 BeforeUpdate，它们是容器控件的事件，您无法使用 withevents“捕获”它们，但通过这种方式，您可以:
Public Sub myExit(ByVal Cancel As MSForms.ReturnBoolean)Attribute myExit.VB_UserMemId = -2147384829Debug.Print "exit"End SubPublic Sub MyEnter()Attribute MyEnter.VB_UserMemId = -2147384830Debug.Print "enter"End Sub