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:
The class associated with the FormFocusListener
The support module:
Finally, in the UserForm:
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:
Code:
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
Code:
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:
Code:
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:
Code:
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