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

John Luther

New Member
Joined
May 5, 2014
Messages
26
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?

VBA Code:
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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,013
First thing ... is the form opened as Non-Modal ?
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows
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

New Member
Joined
May 5, 2014
Messages
26

ADVERTISEMENT

Excel 2016

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

John Luther

New Member
Joined
May 5, 2014
Messages
26
Maybe my primary question is how to keep a userform visible and in front after opening another workbook.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows
Give this a try and see how it goes :

Workbook Demo

1- Code in a Standard Module
VBA Code:
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:
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,163
Messages
5,640,520
Members
417,150
Latest member
cdguinn

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
Top