【问题标题】:which event fires if excel-vba modeless userform window gets focus back?如果 excel-vba 无模式用户窗体窗口重新获得焦点,会触发哪个事件?
【发布时间】:2019-10-01 23:09:48
【问题描述】:

我在 Excel VBA 项目中有一个无模式用户窗体。 用户表单是通过单击电子表格上的按钮加载的(如果相关,不是一个 active-x 按钮)。 由于无模式,用户可以使用 excel 甚至其他应用程序,而不是切换回表单窗口。 如果表单窗口再次变为活动窗口,我需要一个触发事件。 我认为 UserForm_Activate 应该完成这项工作,但它没有(UserForm_GotFocus 也没有,但没有 GotFocus 事件用户表单?)。如果用户切换回无模式用户表单(或者如果没有:是否有任何已知的解决方法),是否会触发任何事件?还是我这里有一些奇怪的错误,Activate 应该触发?

这是我用于测试目的的所有代码:

' standard module:

Sub BUTTON_FormLoad()
    ' associated as macro triggered by button click on a sheet
    UserForm1.Show vbModeless
End Sub


' UserForm1:

Private Sub UserForm_Activate()
    ' does not fire if focus comes back
    Debug.Print "Activated"
End Sub

Private Sub UserForm_GotFocus()
    ' does not fire if focus comes back
    ' wrong code - no GotFocus event for userforms?
    Debug.Print "Focussed"
End Sub

Private Sub UserForm_Click()
    ' only fires if clicked *inside* form
    ' does not fire eg if user clicks top of form window
    Debug.Print "Clicked"
End Sub

在哪里可以找到用户表单事件的文档?它不在“UserForm object”页面上。

【问题讨论】:

标签: excel vba


【解决方案1】:

当您在应用程序和无模式用户窗体之间切换时,Activate 事件不会触发。这是设计使然。

就像我在 cmets 中提到的那样

您可以通过子类化用户窗体并捕获工作表事件来实现您想要的,但它非常混乱。

这是一个非常基本的例子。示例文件可从Here下载

请先阅读我:

  1. 这只是一个基本示例。请在测试之前关闭所有 Excel 文件。
  2. 如果用户直接单击用户窗体上的控件并且您想在那里运行activate code,那么您也必须处理它。
  3. 一旦您感到满意,请根据您的需要进行修改。

将代码放入模块中

Option Explicit

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)

Private Const GWL_WNDPROC = (-4)
Private WinProcOld As Long
Private Const WM_NCLBUTTONDOWN = &HA1

Public formWasDeactivated As Boolean

'~~> Launch the form
Sub LaunchMyForm()
    Dim frm As New UserForm1
    frm.Show vbModeless
End Sub

'~~> Hooking the Title bar in case user clicks on the title bar
'~~> to activate the form
Public Function WinProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_NCLBUTTONDOWN Then
        '~~> Ignoring unnecessary clicks to the title bar
        '~~> by checking if the form was deactivated
        If formWasDeactivated = True Then
            formWasDeactivated = False
            MsgBox "Form Activated"
        End If
    End If

    WinProc = CallWindowProc(WinProcOld&, hwnd&, wMsg&, wParam&, lParam&)
End Function

'~~> Subclass the form
Sub SubClassUserform(hwnd As Long)
    WinProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WinProc)
End Sub

Sub UnSubClassUserform(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WinProcOld&
    WinProcOld& = 0
End Sub

创建一个用户表单。我们称之为Userform1。在表单中添加一个命令按钮。我们就叫它CommandButton1

在用户窗体中放置代码

Option Explicit

Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Dim hwnd As Long

Private Sub UserForm_Initialize()
    hwnd = FindWindow(vbNullString, Me.Caption)
    SubClassUserform hwnd
End Sub

'~~> Userform Click event
Private Sub UserForm_Click()
    '~~> Ignoring unnecessary clicks
    '~~> by checking if the form was deactivated
    If formWasDeactivated = True Then
        formWasDeactivated = False
        MsgBox "Form Activated"
    End If
End Sub

'~~> Unload the form
Private Sub CommandButton1_Click()
    '~~> In case hwnd gets reset for whatever reason.
    hwnd = FindWindow(vbNullString, Me.Caption)
    UnSubClassUserform hwnd

    Unload Me
End Sub

将此代码放在工作簿代码区

Option Explicit

'~~> Checking if the form was deactivated
'~~> Add more events if you want

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    formWasDeactivated = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    formWasDeactivated = True
End Sub

请随时添加更多工作簿事件。我只用过Workbook_SheetActivate和Workbook_SheetSelectionChange

最后在工作表中添加一个表单按钮并将宏LaunchMyForm 分配给它。我们完成了

行动中

【讨论】:

    【解决方案2】:

    据我所知,VBA 中没有这样的事件。来自文档:

    只有在您移动焦点时才会发生激活和停用事件 在一个应用程序中。将焦点移入或移出 另一个应用程序不会触发任何一个事件。

    但是,Windows API 可以使用 hook 处理事件。 VBA 中 Win API 的问题在于 VBA 不处理错误,因此如果/当代码遇到错误时 Excel 将崩溃;所以他们可能会让开发人员感到沮丧。从纯粹个人的角度来看,我喜欢将钩子过程中的代码保持在最低限度,并将任何值传递给可以触发事件的类——这至少可以最大限度地减少崩溃。记住在完成会话之前解开钩子也很重要。

    Win API 挂钩的基本实现如下所示:

    在类对象中(这里称为 cHookHandler)

    Option Explicit
    
    Public Event HookWindowActivated()
    Public Event HookIdChanged()
    
    Private mHookId As LongPtr
    Private mTargetWindows As Collection
    
    Public Property Get HookID() As LongPtr
        HookID = mHookId
    End Property
    
    Public Property Let HookID(RHS As LongPtr)
        mHookId = RHS
        RaiseEvent HookIdChanged
    End Property
    
    Public Sub AttachHook()
        modHook.AttachHook Me
    End Sub
    
    Public Sub DetachHook()
        modHook.DetachHook
    End Sub
    
    Public Sub AddTargetWindow(className As String, Optional windowTitle As String)
        Dim v(1) As String
        
        'Creates an array of [0 => className, 1=> windowTitle]
        'which is stored in a collection and tested for in
        'your hook callback.
        v(0) = className
        v(1) = windowTitle
        mTargetWindows.Add v
        
    End Sub
    
    Public Sub TestForTargetWindowActivated(className As String, windowTitle As String)
        Dim v As Variant
        
        'Tests if the callback window is one that we're after.
        For Each v In mTargetWindows
            If v(0) = className Then
                If v(1) = "" Or v(1) = windowTitle Then
                    'Fires the event that our target window has been activated.
                    RaiseEvent HookWindowActivated
                    Exit Sub
                End If
            End If
        Next
    End Sub
    
    Private Sub Class_Initialize()
        Set mTargetWindows = New Collection
    End Sub
    
    Private Sub Class_Terminate()
        modHook.DetachHook
    End Sub
    

    模块代码(这里的模块称为modHook)

    Option Explicit
    
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As LongPtr) As Long
     
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, _
        ByVal lpfn As LongPtr, _
        ByVal hmod As LongPtr, _
        ByVal dwThreadId As Long) As LongPtr
    
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As LongPtr, _
        ByVal ncode As Long, _
        ByVal wParam As LongPtr, _
        lParam As Any) As LongPtr
        
    Private Declare PtrSafe Function GetClassName Lib "user32" _
        Alias "GetClassNameA" _
        (ByVal hwnd As LongPtr, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long
        
    Private Declare PtrSafe Function GetWindowText Lib "user32" _
        Alias "GetWindowTextA" _
        (ByVal hwnd As LongPtr, _
        ByVal lpString As String, _
        ByVal cch As Long) As Long
        
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    
    Private Const WH_CBT As Long = 5
    Private Const HCBT_ACTIVATE As Long = 5
    
    Private mHookHandler As cHookHandler
    
    Public Sub AttachHook(hookHandler As cHookHandler)
        Set mHookHandler = hookHandler
        mHookHandler.HookID = SetWindowsHookEx(WH_CBT, AddressOf CBTCallback, 0, GetCurrentThreadId)
    End Sub
    
    Private Function CBTCallback(ByVal lMsg As Long, _
                                 ByVal wParam As LongPtr, _
                                 ByVal lParam As LongPtr) As LongPtr
        Dim className As String, windowTitle As String
        
        If mHookHandler Is Nothing Then Exit Function
        
        If lMsg = HCBT_ACTIVATE Then
            className = GetClassText(wParam)
            windowTitle = GetWindowTitle(wParam)
            If Not mHookHandler Is Nothing Then
                mHookHandler.TestForTargetWindowActivated className, windowTitle
            End If
        End If
        CBTCallback = CallNextHookEx(mHookHandler.HookID, lMsg, ByVal wParam, ByVal lParam)
    End Function
    
    Public Sub DetachHook()
        Dim ret As Long
        
        If mHookHandler Is Nothing Then Exit Sub
        
        ret = UnhookWindowsHookEx(mHookHandler.HookID)
        If ret = 1 Then
            mHookHandler.HookID = 0
        End If
    End Sub
    
    Private Function GetWindowTitle(wParam As LongPtr) As String
        Dim tWnd As String
        Dim lWnd As Long
        
        tWnd = String(100, Chr(0))
        lWnd = GetWindowText(wParam, tWnd, 100)
        tWnd = Left(tWnd, lWnd)
    
        GetWindowTitle = tWnd
    End Function
    
    Private Function GetClassText(wParam As LongPtr) As String
        Dim tWnd As String
        Dim lWnd As Long
        
        tWnd = String(100, Chr(0))
        lWnd = GetClassName(wParam, tWnd, 100)
        tWnd = Left(tWnd, lWnd)
    
        GetClassText = tWnd
    End Function
    

    在这个例子中,所有的事件都在Userform

    在这个简单的示例中,Userform 上的两个按钮附加和分离钩子,但您可能会从其他地方调用例程(可能是用户窗体 Initialize 和 Terminate 事件)。 Userform 也有一个标签 lblHook 显示我在开发过程中使用的 HookId - 对于生产代码,你可能不想要这个,所以你可以省略那个。

    Option Explicit
    
    Private WithEvents mHookHandler As cHookHandler
    
    Private Sub btnHook_Click()
        mHookHandler.AttachHook
    End Sub
    
    Private Sub btnUnhook_Click()
        mHookHandler.DetachHook
    End Sub
    
    Private Sub mHookHandler_HookIdChanged()
        lblHook.Caption = mHookHandler.HookID
    End Sub
    
    Private Sub mHookHandler_HookWindowActivated()
        ' Caveat: this routine will crash if halted in debugger.
        Debug.Print "I've been activated!"
    End Sub
    
    Private Sub UserForm_Initialize()
        Set mHookHandler = New cHookHandler
        
        mHookHandler.AddTargetWindow "ThunderDFrame", Me.Caption
    End Sub
    
    Private Sub UserForm_Terminate()
        Set mHookHandler = Nothing
    End Sub
    

    【讨论】:

    • @SiddharthRout,对不起,在我写这篇文章的时候错过了你的钩子答案。认为它们的不同足以保留,但请告诉我,我很乐意删除此答案。
    • 奇怪...我在无模式用户窗体上测试您的代码,但它不起作用。将在某个时候再次签入...THIS 是包含您的代码的文件...
    • @SiddharhRout 我以前也有过,但使用Userform1.Show False 而不是vbModeless 效果很好。不知道为什么。
    • 不,它也不适用于False。顺便说一句?vbModeless=False 会给你真实的。所以没关系:)
    • 我附上了上面的示例文件。你可以在里面测试它
    【解决方案3】:

    试试这个。该事件在表单出现后发生,因此将 wb 隐藏在初始化事件中。

        Private Sub UserForm_Initialize() 
    Set WB = ThisWorkbook Windows(WB.Name).Visible = False
    

    【讨论】:

      【解决方案4】:

      该事件不存在,您可以使用 Windows 挂钩来实现您想要的结果。在我看来,这是直接答案,其他一切都是一种解决方法[除非它是由 Siddharth Rout 发布的,在这种情况下,这就是直接答案]

      【讨论】:

      • 除非有其他解决方案,否则 IMO 的解决方法是一个受欢迎的答案。
      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2017-02-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2011-12-06
      相关资源
      最近更新 更多