Userform to stay open while user clicks to select various values from another workbook

[John Luther]

I haven't been able to find any code to help me with this problem:

I'm trying to create a userform to help import various values from another workbook. The userform is a series of textboxes that, when double clicked, will prompt me to select a value from the other workbook. I just want to be able to open the the other workbook and keep the userform open and visible while I'm selecting values.

Once I have the other workbook open, I'm using this code to get values from it. But once i get the value, it kicks me back to the original workbook. How can I keep my userform floating over the other workbook while I interact with it?

Private Sub txtVendor1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim ImportValue As String
    
    ImportValue = Application.InputBox("Select the Value:", Type:=2)
    ActiveControl.Value = ImportValue

End Sub

 

[Logit]

First thing ... is the form opened as Non-Modal ?

 

[John Luther]

First thing ... is the form opened as Non-Modal ?

yes it is

 

[Jaafar Tribak]

I don't think solving this is going to be easy.

The issue is not the userform. The issue is with the Application.InputBox prompt window wich causes excel to revert back to the initial workbook window after it has been dismissed.

Are you using and MDI or SDI version of excel ? ie: Are you using excel 2013 or later - which excel edition are you using ?

 

[John Luther]

Excel 2016

Is there another way of doing it other than using Application.InputBox?

 

[John Luther]

Maybe my primary question is how to keep a userform visible and in front after opening another workbook.

 

[Jaafar Tribak]

Excel 2016

Is there another way of doing it other than using Application.InputBox?

Not sure but, if you have the RefEdit control installed, you may give it a try as it provides a similar functionality and might work in this particular scenario.

Failing that, the only other possible alternative that I can think of to achieve what you want is to somehow alter the child-parent\owned-owner relationship between the userform and the workbook windows along with subclassing the InputBox. This will need some more complex code but I think, it can be done.

 

[Logit]

I haven't reviewed everything from this resource .. hoping something here will help you :

Keep a UserForm on Top of All Other Windows

 

[Jaafar Tribak]

I haven't reviewed everything from this resource .. hoping something here will help you :

Keep a UserForm on Top of All Other Windows

Hi Logit,

Making the userform topmost won't solve the problem. The InputBox overrides that effect... After selecting a range in the other workbook(s), the focus automatically reverts back to the original workbook.

 

[Jaafar Tribak]

Give this a try and see how it goes :

Workbook Demo

1- Code in a Standard Module

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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    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 SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  
    Private hFormHwnd As LongPtr, hHook As LongPtr, lPrevInputBoxProc As LongPtr

#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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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 SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  
    Private hFormHwnd As Long, hHook As Long, lPrevInputBoxProc As Long

#End If

Private oLastActiveWindow As Window


Public Property Let SetHook(Optional ByVal Form As Object, ByVal Hook As Boolean)

    Const GWL_HWNDPARENT = (-8)
    Const SWP_NOSIZE = &H1
    Const SWP_NOMOVE = &H2
    Const HWND_TOPMOST = -1
    Const HWND_NOTOPMOST = -2
    Const WH_CBT = 5
  
    #If Win64 Then
        Dim hwnd  As LongLong
    #Else
        Dim hwnd  As Long
    #End If  

    Set oLastActiveWindow = Nothing

    If Not Form Is Nothing Then
        Call IUnknown_GetWindow(Form, VarPtr(hwnd))
        hFormHwnd = hwnd
        Call SetWindowLong(hwnd, GWL_HWNDPARENT, 0)
        Call SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE)
        Call UnhookWindowsHookEx(hHook)
        hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(vbNullString), GetCurrentThreadId)
    Else
        Call SetWindowPos(hFormHwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE)
        Call UnhookWindowsHookEx(hHook)
    End If

End Property


#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const HCBT_CREATEWND = 3
    Const HC_ACTION = 0
    Const GWL_WNDPROC As Long = -4
    Const MAX_PATH = 260

    Dim sClassName As String * MAX_PATH, lBuff As Long, lRet As Long
  
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
      
    If lCode = HCBT_CREATEWND Then
        lBuff = MAX_PATH
        lRet = GetClassName(wParam, sClassName, lBuff)
        If Left(sClassName, lRet) = "bosa_sdm_XL9" Then
            Call UnhookWindowsHookEx(hHook)
            lPrevInputBoxProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf InputBoxProc)
            Exit Function
        End If
    End If
  
    Call CallNextHookEx(hHook, lCode, wParam, lParam)
  
End Function


#If Win64 Then
    Private Function InputBoxProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function InputBoxProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC As Long = -4
    Const WM_DESTROY = &H2
    Const WM_COMMAND = &H111

    Select Case Msg
        Case WM_COMMAND
            Set oLastActiveWindow = ActiveWindow
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevInputBoxProc)
            If Not oLastActiveWindow Is Nothing Then
                Call SetForegroundWindow(oLastActiveWindow.hwnd)
            End If
    End Select

    InputBoxProc = CallWindowProc(lPrevInputBoxProc, hwnd, Msg, wParam, ByVal lParam)

End Function

2- Code usage example in the UserForm Module:

Option Explicit

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call ShowInputBox
End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   Call ShowInputBox
End Sub

Private Sub ShowInputBox()
    Dim sImportValue As String
    SetHook(Me) = True
    sImportValue = Application.InputBox("Select the Value:", Type:=2)
    If sImportValue <> "False" Then ActiveControl.Value = sImportValue
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    SetHook = False
End Sub

EDIT:
Note that the above code will only work in Single Document Interface excel versions ie:- Excel 2013 or later