Changing workbook when non-modal form.

Artik

Artik

Active Member
Joined
Jun 5, 2012
Messages
326
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
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
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:
VBA 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

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
VBA Code: 
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
 
Upvote 1
__

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:
VBA 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.
 
Upvote 0
Solution
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
803
huiettcm
H
D
  • Question Question
Call Form from another Form
Replies
3
Views
351
drag1c
D
F
  • Question Question
Making a UserForm behave as a Tool Window for another process
Replies
3
Views
381
fitzmorrispr
F
P
  • Question Question
Checking for Worksheets that already exist
2
Replies
11
Views
467
Logit
Logit
P
  • Question Question
Selected Cell Shown in Different Cell
Replies
2
Views
280
Pacman52
P

Forum statistics

Threads
1,225,062
Messages
6,182,634
Members
453,129
Latest member
mike4slund

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top