Excel UserForm Window 'Focus' Event Listener 1

[huiettcm]

thread707-1747946
I am trying to open multiple user forms in excel for a data collection project. The user can select entries to edit and the data is brough into the form. I can open multiple forms 'vbModeless' however this looses the mouse scroll control (as that class ans support module require a 'vbModal' form). So I'm adapting code from Link to develop an event listener based on the 'WM_ACTIVATE' msg. This event should fire when the user selects an unfocused user form. Then the code will hide and show modal the selected user form as well as hide and show modeless the previous user form.

All the edit rows are put into a collection of forms. Then I open the forms from the collection. Here's what I have so far.

The collection is populated like this:

Public editcoll As Collection
Public Sub Edit_Entry()

Dim newform As DE_Form

'bunch of code to get data rows from across multiple spreadsheets. This is for each selected row.

 Set newform = New DE_Form
 newform.Caption = dc.Cells(rw, "d").value & " " & dc.Cells(rw, "ae").value
 editcoll.Add Item:=newform, Key:=newform.Caption
 newform.Tag = "Modeless"

'Bunch of code to assign form values for each member of the collection.

For Each newform In editcoll
    newform.Show vbModeless
Next newform

The class associated with the FormFocusListener

Option Explicit

Public Event ChangeFocus(ByVal gotFocus As Boolean)

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

The support module:

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 Long
Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" _
    Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr


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

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

Dim i

    ' 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 uMsg
            Case WM_NCACTIVATE ' sent when window border activates OR deactivates
                For i = 1 To editcoll.Count
                    If DE_Form.Caption = editcoll(i).Caption Then
                        
                        editcoll(i).focusListener.ChangeFocusMessage = wParam ' TRUE if border has been activated
                        myWindowProc = CallWindowProc(lPrevWnd, hWnd, uMsg, wParam, ByVal lParam)
                        Exit Function
                    End If
                Next i
            Case WM_DESTROY
                ' Form is closing, so remove subclassing
                Call SetWindowLongPtr(hWnd, GWL_WNDPROC, lPrevWnd)
                myWindowProc = 0
                Exit Function
        End Select
    On Error GoTo 0
End Function 'myWindowProc

Finally, in the UserForm:

Public WithEvents focusListener As FormFocusListener
Public Sub UserForm_Initialize()

'Set our event extender
Set focusListener = New FormFocusListener

'subclass the userform to catch WM_NCACTIVATE msgs
Dim lhWnd As LongPtr

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

For i = 1 To editcoll.Count
    If Me.Caption = editcoll(i).Caption Then
        SetProp lhWnd, "NumberOfInstances", i
        Exit For
    End If
Next i
end sub

Private Sub focusListener_ChangeFocus(ByVal gotFocus As Boolean)

Dim i
Dim nf As DE_Form
Dim ctrl As Control
Dim hWnd As LongPtr

hWnd = FindWindow("ThunderDFrame", Me.Caption)

Set nf = editcoll(GetProp(hWnd, "NumberOfInstances"))

'userform gets focus, hides and redraws modal, attaches mouse scroll
Select Case gotFocus

Case Is = True:
    If nf.Tag = "Modeless" Then
        nf.Hide
        nf.Show vbModal
        nf.Tag = "Modal"
        EnableMouseScroll nf
        GetUserForm (nf)
    End If
'lost focus, saves the current entries into the editcoll collection, disables the mouse and redraws modeless
Case Is = False:
    If nf.Tag = "Modal" Then
        DisableMouseScroll

        For Each ctrl In Me
            nf.Controls(ctrl).value = Me.Controls(ctrl).value
        Next ctrl
    
        nf.Hide
        nf.Show vbModeless
        nf.Tag = "Modeless"
    End If
End Select
End Sub

 

[mintjulep]

Do you have a question?

Or are you sharing? If so, thank you.

 

[huiettcm]

I appologize. I thought it was clear that the code doesn't work. Rereading the post, I obviously forgot to add what the problem is. I am having a hard time diagnosing why the code doesn't work because Excel crashes. Even when I set break points and they hit, excel will crash and I can't watch variables or diagnose anything. A lot of the time the break points won't even hit and excel will just crash. Any help would be greatly appreciated.

 

[mintjulep]

Can you attach a (sanitized if necessary) workbook?

This is the first "interesting" VBA question here in a long time. I and a few others might take a look, but there's less incentive if we need to guess at your Forms, data, etc.

 

[huiettcm]

Of course. I'll post it once I've gone through and cleaned it up.

 

[combo]

How do you collect data and when and how Excel crashes? Excel crashes when you use refedit control with modeless userform, you cannot close Excel and the form then.

Check VBA version, 64-bit does not accept 32-bit API calls.

combo

 

[huiettcm]

That file should be good. The modules are broken up and named the capability they perform. I think the issue is in the DE_Form code somewhere in the formFocus_ChangeListener, or in the formFocus module. However, the edit module is where the data form collection is created.

 

[huiettcm]

@combo. Data is collected through the included form. Submitting the form spreads the data across 4 worksheets. Editing brings the data from those worksheets back into the form. I'd like to be able to open multiple forms at once for editing...and with mouse scroll enabled. All of my API calls should be in 64 bit format for VB7. I don't think it'll compile, otherwise.

 

[combo]

I started from compiling the project, I got some errors in standard VBA functions, so I checked references. There were some references missing, I removed them for checking.
BTW, do you need all of them?

Next I tried to compile the project again, some compile errors:
[pre]Case Is = vbYes: ' Submit_Form code
DE_Form.Clear_Button_Click
DE_Form.GetUserForm ' argument not optional
Case Is = vbCancel:
Unload DE_Form
End Select[/pre]

[pre]Case Is = False: 'DE_Form code
If nf.Tag = "Modal" Then
DisableMouseScroll ' argument not optional

For Each ctrl In Me
nf.Controls(ctrl).value = Me.Controls(ctrl).value
Next ctrl[/pre]

[pre]If Me.ESA_Yes.value = True And Me.AcqTimeLine_cb.value = "" Then ' DE_Form code
Msg = MsgBox("ESA Planned or Completed has been marked 'Yes'" & vbNewLine & _
"Please respond to the 'If Yes, When?' dropdown", vbOKOnly)
Me.GetUserForm ' argument not optional
Me.AcqTimeLine_cb.SetFocus
GoTo bottom
End If[/pre]

Etc?
Following the above, I would check all references first if they are used in the project.
Next, try to compile the project and fix calls.
Having formal code fixed, for testing, set error trapping to 'Break in Class Modules' in general VBE options. Runtime error breaks will be more precise.

Finally, I wonder if someone will go through all the project, it's a lot of code. Try first to localize the problem and send a small selection with the issue.



combo

 

[huiettcm]

I thought I had updated those calls. They should have the Me qualifier at the end. I'll fix that and repost.

 

[strongm]

I'd wade in, given this seems to based on some of my original code. Unfortunately I am on holiday, away from any sort of computer.

But one thing I would point out is that attempting to debug any subclassed form will almost inevitably lead to VBA crashing. The moment you subclass you step outside the safety rails provided by VBA. This is also true of runtime errors in the subclassed code.

 

[mintjulep]

Could you do what you want to do on a single userform with multiple tabs?

Should certainly be easier.

https://www.teachexcel.com/excel-tutorial/2041/multi-page-userform

 

[huiettcm]

to use multiple tabs, I'd have to dynamically create the same form on multiple tabs. IDK about that. Interesting. Maybe set up a mulit-tab form as a frame for the data entry form.....

I have traced my problem in the updated attached workbook. The problem is in the support code module, UserFormListener. Specifically, on this line,

thisform.focusListener.ChangeFocusMessage = wParam

It's like VBA doesn't want to assign this parameter to the UserForm. I made a public variable to make sure that the same UserForm was getting the ChangeFocusMessage.

 

[huiettcm]

I think what I want to accomplish is fundamentally flawed. When multiple userforms are open, if the top form is Modal the other forms are locked. I don't think the WM_NCACTIVATE message can get sent by clicking on a window's header.

 

[huiettcm]

Solved with a click event. On click I compare the mouse position with the user form's. If the mouse is outside a user form and the user form is modal then excel redraws the form as modeless. Same in reverse. So the user can control which form has the mouse scroll with a click.