Changing workbook when non-modal form.

[Artik]

I display a non-modal user form. I want it to be visible also after changing the workbook. Unfortunately, the form is not visible after manually changing the workbook. In addition, the WorkbookActivate and WorkbookDeactivate events at the application level are not raised when the non-modal form is running.
Does anyone know the solution to this problem?

Artik

 

[Artik]

Bump up

Artik

 

[Jaafar Tribak]

Hi Artik

I don't have excel 2010 or earlier versions for testing, but I think this userform behaviour started happening after the single document interface (SDI) feature was first introduced in excel 2013.

Anyways, here is some modified version of a code I wrote before and which worked for me quite nicely for keeping the userform always in the foreground regardless of which workbook/window is currently active:

File Demo:
SickyUserForm.xlsm








1- Add a new Class to your vbaProject and give the class the name of C_StickyForm.
Place this code in the Class Module:

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ShowWindowAsync Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CoLockObjectExternal Lib "ole32.dll" (ByVal punk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function ShowWindowAsync Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare Function CoLockObjectExternal Lib "ole32.dll" (ByVal punk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
#End If

Private WithEvents AppEvents As Application
Private WithEvents cdbrsEvents As CommandBars

Private oForm As Object

Public Sub Init(Form As Object)
    If Val(Application.Version) >= 15 Then
        Call CoLockObjectExternal(Me, True)
        Set oForm = Form
        Set AppEvents = Application
        Set cdbrsEvents = Application.CommandBars
    End If
End Sub

Private Sub AppEvents_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
    Dim hwnd As LongPtr
    Call IUnknown_GetWindow(oForm, VarPtr(hwnd))
    If IsIconic(Wn.hwnd) Then
        Wn.WindowState = xlNormal
    End If
    Call SetOwner(hwnd, Wn.hwnd)
    Call SetActiveWindow(hwnd)
    Call ShowWindowAsync(hwnd, 1&)
    Set cdbrsEvents = Wn.Parent.Parent.CommandBars
End Sub

Private Sub AppEvents_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    Dim hwnd As LongPtr
    Call IUnknown_GetWindow(oForm, VarPtr(hwnd))
    Call SetOwner(hwnd, 0)
    Call FreeMemory
End Sub

Private Sub cdbrsEvents_OnUpdate()
    If FormExists = False Then
        Call FreeMemory
    End If
End Sub

Private Sub SetOwner(ByVal hwnd As LongPtr, Owner As LongPtr)
    Const GWL_HWNDPARENT = (-8)
    Call SetWindowLong(hwnd, GWL_HWNDPARENT, Owner)
End Sub

Private Function FormExists() As Boolean
    Dim oUf As Object
    For Each oUf In VBA.UserForms
        If oForm Is oUf Then
            FormExists = True: Exit Function
        End If
    Next oUf
End Function

Private Sub FreeMemory()
    Call CoLockObjectExternal(Me, False)
    Set oForm = Nothing
    Set cdbrsEvents = Nothing
    Debug.Print "Mem released."
End Sub

2- Code Usage

Option Explicit

Sub ShowForm()

    Dim oStickyForm As C_StickyForm
    Dim oForm As New UserForm1
   
    Set oStickyForm = New C_StickyForm
    oStickyForm.Init oForm
    oForm.Show vbModeless

End Sub

 

[Jaafar Tribak]

__

FILE UPDATE:
SickyUserForm.xlsm

A slight modification of the class code was needed to cater for the scenario where the (current) owner workbook is being closed and it is not ThisWorkbook.
This was a subtle bug that I have just descovered while revisiting the thread/code, so, anyone using this class, please, ignore the previous code and use the one below:

- Fixed C_StickyForm Class code:

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ShowWindowAsync Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CoLockObjectExternal Lib "ole32.dll" (ByVal punk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function ShowWindowAsync Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare Function CoLockObjectExternal Lib "ole32.dll" (ByVal punk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
#End If

Private WithEvents AppEvents As Application
Private WithEvents cdbrsEvents As CommandBars

Private oForm As Object
Private hOwnerHwnd As LongPtr

Public Sub Init(Form As Object)
    If Val(Application.Version) >= 15 Then
        hOwnerHwnd = ThisWorkbook.Windows(1).hwnd
        Call CoLockObjectExternal(Me, True)
        Set oForm = Form
        Set AppEvents = Application
        Set cdbrsEvents = Application.CommandBars
    End If
End Sub

Private Sub AppEvents_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
    Dim hwnd As LongPtr
    Call IUnknown_GetWindow(oForm, VarPtr(hwnd))
    If IsIconic(Wn.hwnd) Then
        Wn.WindowState = xlNormal
    End If
    Call SetOwner(hwnd, Wn.hwnd)
    Call SetActiveWindow(hwnd)
    Call ShowWindowAsync(hwnd, 1&)
    Set cdbrsEvents = Wn.Parent.Parent.CommandBars
End Sub

Private Sub AppEvents_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    #If Win64 Then
        Const NULL_PTR = 0^
    #Else
        Const NULL_PTR = 0&
    #End If
    Dim hwnd As LongPtr
  
    Call IUnknown_GetWindow(oForm, VarPtr(hwnd))
    If Wb Is ThisWorkbook Then
        Call SetOwner(hwnd, NULL_PTR)
        Call FreeMemory
    Else
        Call SetOwner(hwnd, hOwnerHwnd)
    End If
End Sub

Private Sub cdbrsEvents_OnUpdate()
    If FormExists = False Then
        Call FreeMemory
    End If
End Sub

Private Sub SetOwner(ByVal hwnd As LongPtr, Owner As LongPtr)
    Const GWL_HWNDPARENT = (-8)
    Call SetWindowLong(hwnd, GWL_HWNDPARENT, Owner)
End Sub

Private Function FormExists() As Boolean
    Dim oUf As Object
    For Each oUf In VBA.UserForms
        If oForm Is oUf Then
            FormExists = True: Exit Function
        End If
    Next oUf
End Function

Private Sub FreeMemory()
    Call CoLockObjectExternal(Me, False)
    Set oForm = Nothing
    Set cdbrsEvents = Nothing
    Debug.Print "Mem released."
End Sub

Calling code stays the same as in Post#3

Regards.

 

[Artik]

So I guessed that it would not be lightly.
It works beautifully.
I "talked" with Copilot to explain to me the operation of the code. I must admit that he did it quite well. But when I asked him to write me a similarly working code, he did it very willingly, but with cardinal bugs. When I pointed out the errors to him, he told me: "I give up, but you got the code from Jaffar, so don't combine. Maybe someday I'll be as good as him".
Maybe someday he will succeed.

Thanks.
Regards

Artik