Keeping Userform on top when changing active workbook

[Herakles]

Hi

This and similar issues have been covered a number of times but I'm still not able to find a workable solution.

I have a userform with a combobox to select from a list of open workbooks.

I would like to make any of the workbooks the active workbook but the userform is to remain loaded and on top of the workbook.

The userform is set to modeless.

Does anybody have a solution to this one.

Thanks

 

[Jaafar Tribak]

Sorry guys for cluttering this thread and causing unnecessary confusion, but I forgot to handle the workbook closing event (should a workbook be closed by the user while the userform is still loaded) ... I am becoming paranoid about getting this one right once and for all ?

So again, please ignore the previous class code and use this final one:

1- Class code (cFormOnTop)

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongLong, ByVal nIndex As Long, ByVal dwNewLong As LongLong) As LongLong
    #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 SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    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
#Else
    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 Long) As Long
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ShowWindowAsync Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
#End If

Private WithEvents AppEvents As Application
Private oForm As Object, oCombBox As Control


Private Sub Class_Initialize()
    If Val(Application.Version) >= 15 Then
        Set AppEvents = Application
    End If
End Sub

Public Sub Init(ByVal Form As Object, Optional ByVal CombBox As Control)
    If Not CombBox Is Nothing Then
        Set oCombBox = CombBox
    End If
    Set oForm = Form
End Sub

Private Sub AppEvents_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
    #If Win64 Then
        Dim hwnd As LongLong
    #Else
        Dim hwnd As Long
    #End If
   
    Call IUnknown_GetWindow(oForm, VarPtr(hwnd))
    If IsIconic(Wn.hwnd) Then
        Wn.WindowState = xlNormal
    End If
    Call SetOwner(hwnd, Wn.hwnd)
    Call SetForegroundWindow(hwnd)
    Call ShowWindowAsync(hwnd, 1&)
End Sub

Private Sub AppEvents_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    #If Win64 Then
        Dim hwnd As LongLong
    #Else
        Dim hwnd As Long
    #End If
    Call IUnknown_GetWindow(oForm, VarPtr(hwnd))
    Call SetOwner(hwnd, 0)
End Sub

#If Win64 Then
    Private Sub SetOwner(ByVal hwnd As LongLong, Owner As LongLong)
#Else
    Private Sub SetOwner(ByVal hwnd As Long, Owner As Long)
#End If
    Const GWL_HWNDPARENT = (-8)
    Call SetWindowLong(hwnd, GWL_HWNDPARENT, Owner)
    Call UpdateCombo
End Sub

Private Sub UpdateCombo()
    Dim oWbk As Workbook
    If Not oCombBox Is Nothing Then
        With oCombBox
            .Clear
            For Each oWbk In Application.Workbooks
                .AddItem oWbk.Name
            Next
            .Text = ActiveWorkbook.Name
        End With
    End If
End Sub

2- Using the class from the UserForm:

Option Explicit

Private oFormOnTop As cFormOnTop

Private Sub UserForm_Initialize()
    Dim oWbk As Workbook
    With Me.ComboBox1
        For Each oWbk In Application.Workbooks
            .AddItem oWbk.Name
        Next
        .Text = ActiveWorkbook.Name
    End With
    Set oFormOnTop = New cFormOnTop
    oFormOnTop.Init Me, Me.ComboBox1
End Sub

Private Sub ComboBox1_Change()
    On Error Resume Next
    If Me.ComboBox1.ListCount Then
        Workbooks(Me.ComboBox1.Text).Activate
    End If
End Sub