Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

"OnFocus" event for Excel Userforms? 1

Status
Not open for further replies.

MigrantFirmWorker

Programmer
Apr 9, 2003
54
0
0
US
I need to know when my UserForm has gained or lost focus. I haven't found an obvious way of capturing these events. The closest things I've found are the Enter and Exit events for individual controls, but not the UserForm itself.

Any ideas?

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
Yes. They aren't being fired when the focus changes.

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
BTW - this is a modeless form.

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
What do you mean, when the focus changes?

Please present a sequence of events that illustrates this?

How did you test these event codes?
 
Sequence of events:
1) I run the macro that displays the form on the desktop.
2) UserForm_Initialize() & UserForm_Activate() are fired and the form has focus.
3) I select a cell in the worksheet, the form loses focus, the worksheet gains focus. UserForm_Deactivate() is not fired.
4) I click on the form border, the worksheet loses focus, the form gains focus. UserForm_Activate() is not fired.

Test method:
I created Initialize, Activate, Deactivate, and Click event handlers with breakpoints set in each one.
I then manipulate the form and see which breakpoints are hit.

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
I get the picture now.

Looks like a catch 22, maybe.

So a possible workaround might be to ALSO use the WorkbookSheetSelectionChange event to programmatically deactivate the UserForm (might that mean a second UserForm maybe hidden?)
 
Ultimately I'm trying to set the Enabled state of the controls on the form based on conditions on the active worksheet, and doing that in an "OnFocus" event handler is the approach I use in other languages. I was hoping I could possibly set up a custom class for the form "With Events" but I haven't cracked that nut yet.

The Click event works, but only if the form is clicked in specific regions (and the border isn't one of them).

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
I've been an advanced Excel/VBA user for over 20 years and rarely have found it necessary to use a UserForm. My experience could very well be severely limited.

In my design analysis to determine the structure of a workbook, I try to use all the native Excel spreadsheet features possible before using VBA or forms that act like a barrier between the user and the data on the sheet.

So, what's the need for a form? If there's no other logical rational way, then the form's the way to go. So why the form?
 
It's a rather simple application. I keep having a need to copy curves from one graph to another...sometimes on the same worksheet, sometimes to a different workbook.
I select a curve on a graph, press "Copy Curve", then store as many of the relevant parameters as necessary.
I then select the destination graph, press "Paste Curve", and the code creates a new Series and applies all the stored parameters.
A modeless UserForm provides a place to store all the parameters without being tied to a workbook.
It would be nice to disable the Copy button when the Selection is not a curve, and disable the Paste button when there is no ActiveChart.

The app is currently very simple with minimal code and works reasonably well with the exception of having to tell the user why Copy and Paste fail due to invalid selections.

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
>I was hoping I could possibly set up a custom class for the form "With Events" but I haven't cracked that nut yet.

Ok, create a simple class called EventExtender, and copy in the following code:

Code:
[blue] Option Explicit

Public Event Activate(ByVal activation As Long)

Public Property Let ActivateMessage(ByVal vData As Long)
    RaiseEvent Activate(vData)
End Property[/blue]

You then need a support module, with the following code:

Code:
[blue]Option Explicit

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Const WM_ACTIVATE = &H6
Private Const WM_DESTROY = &H2
Public Const WA_ACTIVE As Long = 1

Public Const GWL_WNDPROC = (-4)
Public lPrevWnd As Long

Public Function myWindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    [green]' an unhandled error in message loop may crash xl so let's ignore it (normally not best practice)[/green]
    On Error Resume Next
    Select Case Msg
        Case WM_ACTIVATE [green]' sent when window activates OR deactivates[/green]
            UserForm1.myExtend.ActivateMessage = wParam And &HFFFF ' low word
            Exit Function
        Case WM_DESTROY
            [green]' Form is closing, so remove subclassing[/green]
            Call SetWindowLong(Hwnd, GWL_WNDPROC, lPrevWnd)
            Exit Function
    End Select
    [green]' Default handling for messages we have not handled[/green]
    myWindowProc = CallWindowProc(lPrevWnd, Hwnd, Msg, wParam, ByVal lParam)
End Function[/blue]

Andd finally UserForm1 needs the following code:
Code:
[blue]Option Explicit

Public WithEvents myEventExtend As EventExtender

Private Sub myEventExtend_Activate(ByVal activation As Long)
    Select Case activation <> 0
        Case True
            Debug.Print "Activating"
        Case False
            Debug.Print "Deactivating"
    End Select
End Sub

Private Sub UserForm_Initialize()
    [green]' Set our event extender[/green]
    Dim lhWnd As Long
    Set myEventExtend = New EventExtender
    Me.Caption = "UserForm TestActivation 1" [green]'used in this example to easily find window handle[/green]
    lhWnd = FindWindow(vbNullString, Me.Caption) [green]' better to use FindWindowEx, but this is quick variant for example purposes[/green]
    [green]'subclass the userform to catch WM_ACTIVATE msgs[/green]
    lPrevWnd = SetWindowLong(lhWnd, GWL_WNDPROC, AddressOf myWindowProc)
End Sub[/blue]
 
GetChartElements method might help you.

I'd Google and read the poop on it.

You would be able to know when a chart series is selected.
 
Thanx for all the assistance. Strongm's code was particularly helpful. I never would have figured this out on my own.

It turns out that capturing the form's Activate/Deactivate messages didn't quite get me what I needed. They are only sent when changing applications, not changing focus. However, the WM_NCACTIVATE message is sent "when a title bar or icon needs to be changed to indicate an active or inactive state", which occurs whenever focus is gained or lost. I substituted WM_NCACTIVATE along with a few customizations and...success!

Here is the modified code. I also included the conditional compilation statements for 32bit/64bit compatibility. Critiques are welcome.

FormFocusListener class module:
Code:
Option Explicit

Public Event ChangeFocus(ByVal gotFocus As Boolean)

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

Support module:
Code:
Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare 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 Long
    #If Win64 Then
        Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" _
            Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Public Declare Function SetWindowLongPtr Lib "user32" _
            Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Public lPrevWnd As LongPtr
#Else
    Public Declare Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public 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
    Public Declare Function SetWindowLong Lib "user32" _
        Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public lPrevWnd As Long
#End If

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

#If VBA7 Then
Public Function myWindowProc(ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
#Else
Public Function myWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
    ' This function intercepts window events from the CopyCurveForm and initiates
    ' a ChangeFocus event for the FormFocusListener class object.
    On Error Resume Next ' an unhandled error in message loop may crash xl so let's ignore it (normally not best practice)
        Select Case Msg
            Case WM_NCACTIVATE ' sent when window border activates OR deactivates
                CopyCurveForm.focusListener.ChangeFocusMessage = wParam ' TRUE if border has been activated
                myWindowProc = CallWindowProc(lPrevWnd, hWnd, Msg, wParam, ByVal lParam)
            Case WM_DESTROY
                ' Form is closing, so remove subclassing
                #If VBA7 Then
                    Call SetWindowLongPtr(hWnd, GWL_WNDPROC, lPrevWnd)
                #Else
                    Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWnd)
                #End If
                myWindowProc = 0
            Case Else
                myWindowProc = CallWindowProc(lPrevWnd, hWnd, Msg, wParam, ByVal lParam)
        End Select
    On Error GoTo 0
End Function 'myWindowProc

CopyCurveForm:
Code:
Public WithEvents focusListener As FormFocusListener

Private Sub focusListener_ChangeFocus(ByVal gotFocus As Boolean)
    Dim tn As String, AC As Chart
    If gotFocus Then
        tn = TypeName(Selection)
        CopyButton.enabled = IIf(tn = "Series", True, False)
        On Error Resume Next
            Set AC = ActiveChart
        On Error GoTo 0
        If AC Is Nothing Then
            PasteButton.enabled = False
        Else
            PasteButton.enabled = readyToPaste 'TRUE if curve has been copied
        End If
    End If
End Sub

Private Sub UserForm_Initialize()
    ' Set our event extender
    Set focusListener = New FormFocusListener
    'subclass the userform to catch WM_NCACTIVATE msgs
    #If VBA7 Then
        Dim lhWnd As LongPtr
        lhWnd = FindWindow("ThunderDFrame", Me.Caption)
        lPrevWnd = SetWindowLongPtr(lhWnd, GWL_WNDPROC, AddressOf myWindowProc)
    #Else
        Dim lhWnd As Long
        lhWnd = FindWindow("ThunderDFrame", Me.Caption)
        lPrevWnd = SetWindowLong(lhWnd, GWL_WNDPROC, AddressOf myWindowProc)
    #End If
End Sub

Thanx again!

Chris

-------------------------------------------------------------
"Don't be deceived. We're all temporary employees.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top