You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

多UserForm焦点监听实现导致Excel崩溃求助

问题:多UserForm焦点切换导致Excel崩溃

我参考代码实现事件监听器,用来判断哪个UserForm获得焦点。核心需求是:

  • 打开多个UserForm实例,当前激活的表单设为vbmodal,以便为表单及控件绑定鼠标滚轮事件
  • 用户点击另一个UserForm实例时,该实例先执行.Hide再以.Show vbModal显示;前一个激活的实例则改为vbModeless重新显示

用户可选择1行或多行数据编辑,每条数据对应一个UserForm实例,存入集合editcoll。我先用vbModeless打开集合内所有表单,交由焦点事件处理逻辑管控。

目前遇到的问题:Excel打开表单即崩溃,在UserForm中设置断点也会触发崩溃。即使注释掉focusListener_ChangeFocus()过程,Excel仍会崩溃;只有完全注释所有相关代码才能正常运行,无法定位问题根源,请求帮助。


类模块:FormFocusListener

Option Explicit

Public Event ChangeFocus(ByVal gotFocus As Boolean)

Public Property Let ChangeFocusMessage(ByVal gotFocus As Boolean)
    RaiseEvent ChangeFocus(gotFocus)
End Property

标准模块

Option Explicit

Public Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function CallWindowProc Lib "user32" _
    Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" _
    Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Public lPrevWnd As LongPtr

Private Const WM_NCACTIVATE = &H86
Private Const WM_DESTROY = &H2
Public Const GWL_WNDPROC = (-4)

Public Function myWindowProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr

    ' 拦截UserForm的窗口事件,触发FormFocusListener类的ChangeFocus事件
    On Error Resume Next ' 消息循环中的未处理错误会导致Excel崩溃,暂时忽略(非常规最佳实践)
        Select Case uMsg
            Case WM_NCACTIVATE ' 窗口边框激活或失活时触发
                DE_Form.focusListener.ChangeFocusMessage = wParam ' 边框激活时为TRUE
                myWindowProc = CallWindowProc(lPrevWnd, hWnd, uMsg, wParam, ByVal lParam)
            Case WM_DESTROY
                ' 表单关闭时移除子类化
                Call SetWindowLongPtr(hWnd, GWL_WNDPROC, lPrevWnd)
                myWindowProc = 0
            Case Else
                myWindowProc = CallWindowProc(lPrevWnd, hWnd, uMsg, wParam, ByVal lParam)
        End Select
    On Error GoTo 0
End Function 'myWindowProc

UserForm(DE_Form)代码

Option Explicit

Public WithEvents focusListener As FormFocusListener
Public Sub UserForm_Initialize()

' 初始化事件扩展类
Set focusListener = New FormFocusListener

' 子类化UserForm以捕获WM_NCACTIVATE消息
Dim lhWnd As LongPtr

lhWnd = FindWindow("ThunderDFrame", Me.Caption)
lPrevWnd = SetWindowLongPtr(lhWnd, GWL_WNDPROC, myWindowProc) 'AddressOf myWindowProc)

End Sub
Private Sub focusListener_ChangeFocus(ByVal gotFocus As Boolean)

Dim i
Dim nf As DE_Form
Dim ctrl As Control

' 表单获得焦点:隐藏后以模态重新显示,绑定鼠标滚轮事件
If gotFocus = True Then
    Me.Hide
    Me.Show vbModal
    EnableMouseScroll Me
End If

' 表单失去焦点:保存当前数据到editcoll集合,解绑鼠标滚轮,以非模态重新显示
If Not gotFocus Then
    DisableMouseScroll
    
    For i = 1 To editcoll.Count
        Set nf = editcoll(i)
        
        If Me.Caption = nf.Caption Then
            For Each ctrl In Me
                nf.Controls(ctrl).Value = Me.Controls(ctrl).Value
            Next ctrl
            Exit For
        End If
    Next i
    
    Me.Hide
    nf.Show vbModeless
End If

End Sub

内容的提问来源于stack exchange,提问作者Chris H.

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.01 19:20:56