如何在Excel加载项中检测用户窗体加载（不修改目标窗体事件）

一、核心实现：SetWinEventHook实时检测窗体创建 #

以下是完整的VBA代码实现，利用Windows API的SetWinEventHook捕获窗口创建事件，定位Excel的ThunderDFrame窗口，进而关联到对应的用户窗体对象进行翻译：

1. API声明与全局变量 #

Option Explicit

' Windows API 声明
Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" ( _
    ByVal eventMin As Long, _
    ByVal eventMax As Long, _
    ByVal hmodWinEventProc As LongPtr, _
    ByVal pfnWinEventProc As LongPtr, _
    ByVal idProcess As Long, _
    ByVal idThread As Long, _
    ByVal dwFlags As Long _
) As LongPtr

Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" ( _
    ByVal hWinEventHook As LongPtr _
) As Boolean

Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" ( _
    ByVal hWnd As LongPtr, _
    lpdwProcessId As Long _
) As Long

Private Declare PtrSafe Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
    ByVal hWnd As LongPtr, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long _
) As Long

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc.dll" ( _
    ByVal hWnd As LongPtr, _
    ByVal dwId As Long, _
    riid As Any, _
    ppvObject As Object _
) As Long

' 常量定义
Private Const EVENT_OBJECT_CREATE As Long = &H8000
Private Const WINEVENT_OUTOFCONTEXT As Long = &H0
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

' 钩子句柄
Private m_hHook As LongPtr

2. 钩子初始化与卸载 #

' 启动钩子，捕获当前Excel进程内的窗口创建事件
Public Sub StartUserFormHook()
    ' 捕获所有进程的窗口创建事件，后续在回调中过滤Excel进程
    m_hHook = SetWinEventHook(EVENT_OBJECT_CREATE, EVENT_OBJECT_CREATE, 0, _
                              AddressOf WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT)
End Sub

' 停止钩子，避免内存泄漏
Public Sub StopUserFormHook()
    If m_hHook <> 0 Then
        UnhookWinEvent m_hHook
        m_hHook = 0
    End If
End Sub

' 获取当前进程ID的API声明
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32.dll" () As Long

3. 回调函数：处理窗口创建事件 #

Private Sub WinEventProc(ByVal hWinEventHook As LongPtr, ByVal event As Long, _
                         ByVal hWnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, _
                         ByVal idEventThread As Long, ByVal dwmsEventTime As Long)
                         
    ' 只处理顶层窗口的创建事件
    If event <> EVENT_OBJECT_CREATE Or idObject <> 0 Then Exit Sub
    
    ' 获取窗口类名，判断是否为Excel用户窗体（ThunderDFrame）
    Dim className As String * 256
    GetClassName hWnd, className, 256
    className = Left(className, InStr(className, vbNullChar) - 1)
    
    If className <> "ThunderDFrame" Then Exit Sub
    
    ' 验证窗口所属进程是否为当前Excel进程
    Dim procID As Long
    GetWindowThreadProcessId hWnd, procID
    If procID <> GetCurrentProcessId() Then Exit Sub
    
    ' 通过AccessibleObjectFromWindow获取用户窗体对象
    Dim userForm As Object
    Dim IID_IDispatch As GUID
    With IID_IDispatch
        .Data1 = &H20400
        .Data2 = &H0
        .Data3 = &H0
        .Data4(0) = &HC0
        .Data4(1) = &H0
        .Data4(2) = &H0
        .Data4(3) = &H0
        .Data4(4) = &H0
        .Data4(5) = &H0
        .Data4(6) = &H0
        .Data4(7) = &H46
    End With
    
    If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, IID_IDispatch, userForm) = 0 Then
        ' 调用翻译函数处理用户窗体控件
        TranslateUserFormControls userForm
    End If
End Sub

' GUID结构定义
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

4. 翻译用户窗体控件的核心函数 #

' 递归遍历用户窗体的所有控件并翻译文本
Private Sub TranslateUserFormControls(parentCtrl As Object)
    Dim ctrl As Object
    
    ' 翻译当前控件的Caption（如果有）
    On Error Resume Next ' 兼容不同类型控件
    If Not IsEmpty(parentCtrl.Caption) Then
        parentCtrl.Caption = TranslateText(parentCtrl.Caption) ' 替换为你的翻译逻辑
    End If
    ' 可扩展翻译其他属性：如TooltipText、Text等
    If Not IsEmpty(parentCtrl.Text) Then
        parentCtrl.Text = TranslateText(parentCtrl.Text)
    End If
    On Error GoTo 0
    
    ' 递归处理子控件（如Frame、MultiPage内的控件）
    For Each ctrl In parentCtrl.Controls
        TranslateUserFormControls ctrl
    Next ctrl
End Sub

' 示例翻译函数，请替换为你的实际翻译逻辑
Private Function TranslateText(originalText As String) As String
    ' 这里只是示例，实际需调用你的翻译引擎或字典
    Select Case originalText
        Case "Hello": TranslateText = "你好"
        Case "Cancel": TranslateText = "取消"
        Case Else: TranslateText = originalText ' 未匹配则保留原文本
    End Select
End Function

二、替代思路：定时枚举窗口检测 #

如果钩子实现过于复杂，可以采用定时检测方案，通过EnumWindows枚举所有ThunderDFrame窗口，关联到Excel用户窗体：

' 示例定时检测逻辑，可放在加载项初始化中
Public Sub CheckForUserFormsPeriodically()
    Dim hWnd As LongPtr
    hWnd = FindWindow("ThunderDFrame", vbNullString) ' 查找第一个ThunderDFrame窗口
    
    Do While hWnd <> 0
        ' 验证是否属于当前Excel进程，然后获取窗体对象并翻译（同钩子部分逻辑）
        Dim procID As Long
        GetWindowThreadProcessId hWnd, procID
        If procID = GetCurrentProcessId() Then
            Dim userForm As Object
            Dim IID_IDispatch As GUID
            With IID_IDispatch
                .Data1 = &H20400
                .Data2 = &H0
                .Data3 = &H0
                .Data4(0) = &HC0
                .Data4(1) = &H0
                .Data4(2) = &H0
                .Data4(3) = &H0
                .Data4(4) = &H0
                .Data4(5) = &H0
                .Data4(6) = &H0
                .Data4(7) = &H46
            End With
            
            If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, IID_IDispatch, userForm) = 0 Then
                TranslateUserFormControls userForm
            End If
        End If
        
        hWnd = FindWindowEx(0, hWnd, "ThunderDFrame", vbNullString) ' 查找下一个窗口
    Loop
    
    ' 设置1秒后再次检测，可通过Application.OnTime实现
    Application.OnTime Now + TimeValue("00:00:01"), "CheckForUserFormsPeriodically"
End Sub

' 补充API声明
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String _
) As LongPtr

Private Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As LongPtr, _
    ByVal hWnd2 As LongPtr, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String _
) As LongPtr

三、关键注意事项 #

• 钩子卸载：必须在加载项关闭或Excel退出时调用StopUserFormHook，否则可能导致Excel崩溃。
• 错误处理：控件遍历和属性访问需加错误处理，避免因自定义控件或特殊属性导致报错。
• 进程过滤：务必验证窗口所属进程为当前Excel进程，避免误处理其他Office程序的用户窗体。
• 性能优化：钩子回调中尽量减少耗时操作，翻译逻辑可异步处理（如果支持）。

内容的提问来源于stack exchange，提问作者Bernd