多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.
相关产品推荐
相关产品推荐

