Cool RefEdit Alternative - (Made with a standard TextBox !)

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,779
Office Version
  1. 2016
Platform
  1. Windows
Hi all.

In a previous thread ,our member Jon Von Der Heyden kindly brought my attention to this recent blog by (John Peltier) about using RefEdit control alternatives. This is what gave me the idea to work on the solution I am providing here.

We know all too well how buggy and unreliable the RefEdit Control is yet it has a nice functionality.

John Peltier's alternative is based on the use of a standard textbox with a DropDown click button but the way he went about it is not , in my humble opinion, elegant or practical as one still has to go through an annoying intermediate Excel InputBox which just seems too clumsy and kind of defeats the whole purpose.(you can see this by downloading his workbook example from the above blog link)

Here, I provide a large improvement on John Peltier's solution. It is based on the same idea but it is far closer to the real RefEdit feel, look and functionality.Obviously more complex code is involved.

Workbook Demo.

Project code : (Needs a UserForm, 2 Buttons and 1 TextBox)

Add a Class module to the Project and give it the name of : (CRefEdit)

1- Class code :
Code:
Option Explicit
 
Private WithEvents TextBoxDropButton_Click As MSForms.TextBox
 
Private WithEvents WbEvents As Workbook
 
Private Sub Class_Initialize()
 
    Set WbEvents = ThisWorkbook
 
End Sub
                             [B][COLOR=seagreen]'Remove the Red[/COLOR][/B] [COLOR=red][B]*[/B][/COLOR]
Private Sub TextBoxDropButton_Click_DropButton[COLOR=red][B]*[/B][/COLOR]Click() 
 
    Call ShowWindow(FindWindow("ThunderDFrame", vbNullString), 0)
    Call StartHook(True)
    Call ShowWindow(FindWindow("ThunderDFrame", vbNullString), 1)
 
End Sub
 
Public Sub TransformTextBoxIntoRefEdit _
(ByVal TextBox As MSForms.TextBox)
 
    Set TextBoxDropButton_Click = TextBox
    Set oTextBox = TextBoxDropButton_Click
    TextBox.DropButtonStyle = fmDropButtonStyleReduce
    TextBox.ShowDropButtonWhen = fmShowDropButtonWhenAlways
 
End Sub
 
Private Sub WbEvents_BeforeClose(Cancel As Boolean)
 
    SendMessage lInputBoxhwnd, WM_CLOSE, 0, 0
 
End Sub

2- Code in the UserForm module

Code:
Option Explicit
 
Private MyRefEditClass As CRefEdit
 
Private Sub UserForm_Activate()
 
    Set MyRefEditClass = New CRefEdit
 
    MyRefEditClass.TransformTextBoxIntoRefEdit TextBox1
 
End Sub
 
Private Sub CommandButton1_Click()
 
        MsgBox "You selected range : " & vbNewLine _
        & sRangeAddress, vbInformation
 
End Sub
 
Private Sub CommandButton2_Click()
 
    Unload Me
 
End Sub
 
Private Sub UserForm_Terminate()
 
    sRangeAddress = ""
 
End Sub

3- Main code in a Standard module :

Code:
Option Explicit
 
[COLOR=seagreen]'\\ Private declarations.[/COLOR]
[COLOR=seagreen]'=========================[/COLOR]
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
 
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
 
Private Declare Function GetWindow Lib "user32.dll" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
 
Private Declare Function GetWindowRect Lib "user32.dll" _
(ByVal hwnd As Long, ByRef lpRect As RECT) As Long
 
Private Declare Function GetClientRect Lib "user32.dll" _
(ByVal hwnd As Long, _
ByRef lpRect As RECT) 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 GetCurrentThreadId _
Lib "kernel32" () As Long
 
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 GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
 
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch 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 Declare Function CreateWindowEx Lib "user32" _
Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, ByVal lpClassName As String, _
ByVal lpWindowName _
As String, ByVal dwStyle As Long, ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, ByVal hInstance As Long, _
lpParam As Any) As Long
 
Private Declare Function SetParent Lib "user32.dll" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
 
Private Declare Function GetDC Lib "user32.dll" _
(ByVal hwnd As Long) As Long
 
Private Declare Function GetDeviceCaps Lib "gdi32.dll" _
(ByVal hdc As Long, _
ByVal nIndex As Long) As Long
 
Private Const WH_CBT As Long = 5
Private Const GWL_WNDPROC As Long = -4
Private Const HCBT_ACTIVATE As Long = 5
Private Const GW_CHILD As Long = 5
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SM_CYCAPTION As Long = 4
Private Const LOGPIXELSY As Long = 90
Private Const WS_CHILD As Long = &H40000000
Private Const WS_EX_CLIENTEDGE As Long = &H200&
Private Const WM_LBUTTONDOWN As Long = &H201
 
Private lhHook As Long
Private bHookEnabled As Boolean
Private lCustomBtnHwnd As Long
Private EditBoxhwnd As Long
Private lPrvWndProc As Long
 
[COLOR=seagreen]'\\ Public declarations.[/COLOR]
[COLOR=seagreen]'=========================[/COLOR]
Public Declare Function FindWindow Lib "user32.dll" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Public Declare Function ShowWindow Lib "user32.dll" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
 
Public Declare Function SendMessage Lib "user32.dll" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByRef lParam As Any) As Long
 
Public Const WM_CLOSE As Long = &H10
 
Public lInputBoxhwnd As Long
Public sRangeAddress As String
Public oTextBox As MSForms.TextBox
 
Sub StartHook(Dummy As Boolean)
 
    Dim sBuffer As String
    Dim lRet As Long
    Dim lhwnd As Long
    Dim sFormCaption As String
 
    lhwnd = FindWindow("ThunderDFrame", vbNullString)
    sBuffer = Space(256)
    lRet = GetWindowText(lhwnd, sBuffer, 256)
    sFormCaption = Left(sBuffer, lRet)
    If Not bHookEnabled Then
        lhHook = SetWindowsHookEx _
        (WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
        bHookEnabled = True
        Application.InputBox "", sFormCaption, Type:=8
    End If
 
End Sub
 
Private Sub TerminateHook()
 
    UnhookWindowsHookEx lhHook
    bHookEnabled = False
 
End Sub
 
Private Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
 
    Dim tRect1 As RECT
    Dim tRect2 As RECT
    Dim sBuffer As String
    Dim PixelPerInch As Single
    Dim lRetVal As Long
 
 
    On Error Resume Next
 
    If idHook = HCBT_ACTIVATE Then
        sBuffer = Space(256)
        lRetVal = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRetVal) = "bosa_sdm_XL9" Then
            lInputBoxhwnd = wParam
            PixelPerInch = _
            GetDeviceCaps(GetDC(0), LOGPIXELSY) / 72
            EditBoxhwnd = GetWindow(wParam, GW_CHILD)
            GetClientRect wParam, tRect1
            Call TerminateHook
            SetWindowPos EditBoxhwnd, 0, 2, 0, _
            0, 0, SWP_NOSIZE
            GetWindowRect EditBoxhwnd, tRect2
            SetWindowPos wParam, 0, 0, 0, _
            tRect1.Right - tRect1.Left, _
            (tRect2.Bottom - tRect2.Top) * PixelPerInch + _
            GetSystemMetrics(SM_CYCAPTION) _
            + GetSystemMetrics(6) * 2, SWP_NOMOVE
            With tRect2
                lCustomBtnHwnd = CreateWindowEx _
                (WS_EX_CLIENTEDGE, "Button", "...", WS_CHILD, _
                255, 0, _
                (tRect1.Right - tRect1.Left) _
                - (.Right - .Left) + 10, _
                .Bottom - .Top + 4, wParam, 0, 0, 0)
            End With
            SetParent lCustomBtnHwnd, wParam
            ShowWindow lCustomBtnHwnd, 1
            lPrvWndProc = SetWindowLong _
            (lCustomBtnHwnd, GWL_WNDPROC, AddressOf CallBack)
        End If
    End If
 
    HookProc = CallNextHookEx _
    (lhHook, idHook, ByVal wParam, ByVal lParam)
 
End Function
 
Private Function CallBack _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
 
    Dim sBuffer As String
    Dim lRet As Long
 
    On Error Resume Next
 
    Select Case Msg
        Case Is = WM_LBUTTONDOWN
            sBuffer = Space(256)
            lRet = GetWindowText(EditBoxhwnd, sBuffer, 256)
            If InStr(1, Left(sBuffer, lRet), "!") Then
                sRangeAddress = Left(sBuffer, lRet)
            Else
                sRangeAddress = ActiveSheet.Name & "!" & _
                Left(sBuffer, lRet)
            End If
            oTextBox.Text = sRangeAddress
            SendMessage lInputBoxhwnd, WM_CLOSE, 0, 0
    End Select
 
    CallBack = CallWindowProc _
    (lPrvWndProc, hwnd, Msg, wParam, ByVal lParam)
 
End Function

This works on the activesheet, on different sheets and on other open workbooks.

Also, thanks to placing the code into a Class, one can have multiple TextBoxes simultaniously transformed into RefEdit-like controls not just one textbox.

I am still looking to improve a bit the look of the Collapsing Button and hope to post an update soon.

Worde well in Excel2003 Win XP. Not tested on other versions.
 
Last edited:
I have noticed this works perfectly except for when one hit "Enter" instead of pressing the button on the control. If you press the button on the control, the Range in the RefEdit is returned to the form. But, it you just hit Enter, the RefEdit Closes and does not return the Range to the form. Any suggestions on how to fix this?
 
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
I have noticed this works perfectly except for when one hit "Enter" instead of pressing the button on the control. If you press the button on the control, the Range in the RefEdit is returned to the form. But, it you just hit Enter, the RefEdit Closes and does not return the Range to the form. Any suggestions on how to fix this?

Hi,

Some time ago, I rewrote this RefEdit alternative but never published it on this thread.

This new version uses a different approach by hijacking the xlDialogGoalSeek native window which has a nice looking collapse\Expand button... I have also fixed the Enter and Escape keys issue you reported.

I only tested this on my PC Win 10 64bit , Office 10 64Bit. I hope this works well accross other platforms.

Here is a preview when I ran it on my PC:

 
Last edited:
Upvote 0

Workbook demo
:

1- CRefEdit Class :
Code:
Option Explicit

Private WithEvents oTextBox As MSForms.Textbox
Private oUF As Object
 
Public Property Set UserForm(ByVal Frm As Object)
    Set oUF = Frm
    Frm.Tag = IsFormModal(Frm)
End Property
 
Public Sub TransformTextBoxIntoRefEdit(ByVal Textbox As Object)
    Set oTextBox = Textbox
    Textbox.DropButtonStyle = fmDropButtonStyleReduce
    Textbox.ShowDropButtonWhen = fmShowDropButtonWhenAlways
End Sub
 
Private Sub oTextBox_DropButt*******() ' [COLOR=#008000]<== replace [B]*******[/B] with: [/COLOR][COLOR=#ff0000][B]on Click [/B][/COLOR][COLOR=#008000]without the space[/COLOR]
    Call StoreTextboxWidth(oTextBox)
    Call ShowForm(oUF, False)
    Call ShowRefEdit(True)
    Call ShowForm(oUF, True)
End Sub

2- Standard Module:
Code:
Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type WINDOWPOS
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        hwnd As LongPtr
        hWndInsertAfter As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        hwnd As Long
        hWndInsertAfter As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
        x As Long
        y As Long
        cx As Long
        cy As Long
        flags As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    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 Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) 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 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 GetCurrentThreadId Lib "kernel32" () 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    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 GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long
    Private Declare PtrSafe Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal fEnable As Long) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    
    Private lhHook As LongPtr, lPrvWndProc As LongPtr, RefEditHwnd As LongPtr, hwndFrm As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC 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 Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) 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 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 GetCurrentThreadId Lib "kernel32" () 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function GetFocus Lib "user32" () As Long
    
    Private lhHook As Long, lPrvWndProc As Long, RefEditHwnd As Long, hwndFrm As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const WH_CBT = 5
Private Const GWL_WNDPROC = -4
Private Const HCBT_ACTIVATE = 5
Private Const GW_CHILD = 5
Private Const MK_LBUTTON = &H1
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_SYSCOMMAND = &H112
Private Const WM_CLOSE As Long = &H10
Private Const SC_CLOSE = &HF060&
Private Const SWP_SHOWWINDOW = &H40
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const POINTS_PER_INCH = 72
 
Private dblTextboxwidth As Double
Private oTextBox As Object
Private bHookEnabled As Boolean


Public Sub StoreTextboxWidth(ByVal Textbox As Object)
    Set oTextBox = Textbox
    dblTextboxwidth = Textbox.Width
End Sub

Public Sub ShowForm(ByVal Frm As Object, ByVal Show As Boolean)
    SetActiveWindow Application.hwnd
    Call ShowWindow(hwndFrm, -CLng(Show))
    If Frm.Tag Then EnableWindow Application.hwnd, 0
End Sub
 
Public Function IsFormModal(Frm As Object) As Boolean
    IsFormModal = Not CBool(SetFocus(Application.hwnd))
    WindowFromAccessibleObject Frm, hwndFrm
    Call SetFocus(hwndFrm)
End Function

Public Sub ShowRefEdit(Dummy As Boolean)
 
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim lVBEhwnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim lVBEhwnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Dim sBuffer As String
    Dim lRet As Long
    
    lVBEhwnd = FindWindow("wndclass_desked_gsk", vbNullString)
    ShowWindow lVBEhwnd, 0
    sBuffer = Space(256)
    lRet = GetWindowText(hwndFrm, sBuffer, 256)
    If Not bHookEnabled Then
        lhHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
        bHookEnabled = True
        DoEvents
        Application.Dialogs(xlDialogGoalSeek).Show
    End If
 
End Sub
 
Private Sub TerminateHook()
    UnhookWindowsHookEx lhHook
    bHookEnabled = False
End Sub
 
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
     Dim lp As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim lp As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
    Dim tFrmRect As RECT, tRefRect As RECT
    Dim p1 As POINTAPI, p2 As POINTAPI
    Dim sBuffer As String
    Dim PixelPerInch As Single
    Dim lRet As Long
 
    If idHook = HCBT_ACTIVATE Then
        sBuffer = Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "bosa_sdm_XL9" Then
            Call TerminateHook
            RefEditHwnd = GetWindow(wParam, GW_CHILD)
            GetWindowRect hwndFrm, tFrmRect
            GetWindowRect RefEditHwnd, tRefRect
            With tRefRect
                p1.x = .Left: p1.y = .Top + 5
                p2.x = .Right + 15: p2.y = .Bottom
            End With
            ScreenToClient wParam, p1
            ScreenToClient wParam, p2
            lp = MakeLong_32_64(p2.x, p1.y)
            With tFrmRect
                SetWindowPos wParam, Application.hwnd, .Left, .Top, PTtoPX(dblTextboxwidth, False), 0, 0 + SWP_SHOWWINDOW
            End With
            PostMessage RefEditHwnd, WM_LBUTTONDOWN, MK_LBUTTON, lp
            PostMessage RefEditHwnd, WM_LBUTTONUP, MK_LBUTTON, lp
            
            lPrvWndProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf CallBack)
        End If
    End If
 
    HookProc = CallNextHookEx(lhHook, idHook, ByVal wParam, ByVal lParam)
 
End Function

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function CallBack(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function CallBack(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
    Dim tWinpos As WINDOWPOS
    Dim sBuffer1 As String, sBuffer2 As String, sBuffer3 As String
    Dim lRet1 As Long, lRet2 As Long, lRet3 As Long
    
    If GetFocus <> hwnd Then SetFocus hwnd
     
    sBuffer1 = Space(256): sBuffer2 = Space(256)
    lRet1 = GetWindowText(RefEditHwnd, sBuffer1, 256): lRet2 = GetWindowText(hwnd, sBuffer2, 256)
   
    If InStr(1, Left(sBuffer1, lRet1), "!") = 0 Then
        SetWindowText RefEditHwnd, ActiveSheet.Name & "!" & Left(sBuffer1, lRet1)
    End If
    If Left(sBuffer2, lRet2) <> "RefEdit" Then
        SetWindowText hwnd, "RefEdit"
    End If
    
    If GetAsyncKeyState(VBA.vbKeyEscape) Or GetAsyncKeyState(VBA.vbKeyReturn) Or _
        GetAsyncKeyState(VBA.vbKeySeparator) Then
        sBuffer3 = Space(256)
        lRet3 = GetWindowText(RefEditHwnd, sBuffer3, 256)
        oTextBox.Text = Left(sBuffer3, lRet3)
        PostMessage hwnd, WM_CLOSE, 0, 0
    End If

    Select Case Msg
        Case Is = WM_WINDOWPOSCHANGING
            CopyMemory tWinpos, ByVal lParam, Len(tWinpos)
            tWinpos.cy = (GetSystemMetrics(31)) + (GetSystemMetrics(4)) + (GetSystemMetrics(7)) + 2
            CopyMemory ByVal lParam, tWinpos, Len(tWinpos)
        Case Is = WM_SYSCOMMAND
            If wParam = SC_CLOSE Then
                SetActiveWindow Application.hwnd
                PostMessage hwnd, WM_CLOSE, 0, 0
                oTextBox.Text = Left(sBuffer1, lRet1)
            End If
        Case WM_LBUTTONDOWN, WM_LBUTTONUP
            SetActiveWindow Application.hwnd
            PostMessage hwnd, WM_CLOSE, 0, 0
            oTextBox.Text = Left(sBuffer1, lRet1)
        Case Is = WM_CLOSE
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrvWndProc)
    End Select

    CallBack = CallWindowProc(lPrvWndProc, hwnd, Msg, wParam, ByVal lParam)
 
End Function

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
    Function MakeLong_32_64(ByVal wLow As Long, ByVal wHigh As Long) As LongPtr
    Dim retVal As LongPtr, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 4
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 4
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 8
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function MakeLong_32_64(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
    Dim retVal As Long, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 2
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 2
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 4
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    End Function
    
Private Function ScreenDPI(bVert As Boolean) As Long
    Static lDPI(1), lDC
    
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function
 
Private Function PTtoPX(Points As Double, bVert As Boolean) As Long
    PTtoPX = Points * ScreenDPI(bVert) / POINTS_PER_INCH
End Function

3- UserForm Module :
Code:
Option Explicit
 
Private AlternativeRefEdit1 As CRefEdit
Private AlternativeRefEdit2 As CRefEdit

Private Sub UserForm_Activate()
 
    Set AlternativeRefEdit1 = New CRefEdit
    Set AlternativeRefEdit2 = New CRefEdit
    
    Set AlternativeRefEdit1.UserForm = Me
    Set AlternativeRefEdit2.UserForm = Me
    
    AlternativeRefEdit1.TransformTextBoxIntoRefEdit TextBox1
    AlternativeRefEdit2.TransformTextBoxIntoRefEdit TextBox3

End Sub
 
Upvote 0
THANK YOU! I will give this a try on my machine and see if I can get it to work!

By any chance do you know why the address is not returned to the textbox in the previous control if enter is pressed?
I have been looking for a hook to write on that event (enter being pressed) but have not been successful as of yet.

Brian
 
Upvote 0
This works perfectly for me using Microsoft Office Professional Plus 2013 Under Windows 7 32 Bit.
I will test on other systems and if I have issues will let you know if working or not working.
Thanks for Sharing!!! :)
 
Upvote 0
This works perfectly for me using Microsoft Office Professional Plus 2013 Under Windows 7 32 Bit.
I will test on other systems and if I have issues will let you know if working or not working.
Thanks for Sharing!!! :)

Thanks for the feedback bissettbd.

For those using Office 2007 or earlier versions, Clicking the TextBox Button will crash the application.

The issue was a mistake in the SetWindoLong API declararion syntax. I somehow forgot to add the 3rd argument.

The correct declaration should read :

Code:
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long[COLOR=#0000ff][B], ByVal dwNewLong As Long[/B][/COLOR]) As Long

Corrected Workbook Demo
 
Upvote 0
Thank you for this great code! Jaafar. I have been working on trying to implement a couple of items.

1. It seems like the callback once inside the GoalSeek input box breaks Shift + Arrow Key highlighting. Any suggestions on how to get this functionality back?

2. The "?" in the title bar still takes you to the GoalSeek help. I tried to turn the "?" off using WS_EX_CONTEXTHELP: https://docs.microsoft.com/en-us/windows/win32/winmsg/extended-window-styles and getwindowlong, but perhaps I was modifying the style I got back form getwindowlong incorrectly. I have lost all that code now or I would post a sample.

3. When clicking on the button in the text box the current selection is always being set as the input instead of the prior selection. Is there a reason you chose this default behavior.

Thank you,
 
Upvote 0
Hi wsDAH,

Thanks for spotting those limitations and letting me know .

1- The Shift + Arrow issue is solved by displaying the userform as Modeless (Couldn't make it work with Modal forms)
2- the annoying "?" icon on the title bar is now removed as requested.
3- Prior user selection is now preserved.

Update:
Workbook example



RefEditEx.gif



Updated API code :
Code:
Option Explicit 

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type WINDOWPOS
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        hwnd As LongPtr
        hWndInsertAfter As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        hwnd As Long
        hWndInsertAfter As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
        x As Long
        y As Long
        cx As Long
        cy As Long
        flags As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    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 Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) 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 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 GetCurrentThreadId Lib "kernel32" () 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    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 GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long
    Private Declare PtrSafe Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal fEnable As Long) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

    Private lhHook As LongPtr, lPrvWndProc As LongPtr, RefEditHwnd As LongPtr, hwndFrm As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC 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 Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) 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 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 GetCurrentThreadId Lib "kernel32" () 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function GetFocus Lib "user32" () As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

    Private lhHook As Long, lPrvWndProc As Long, RefEditHwnd As Long, hwndFrm As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const GWL_WNDPROC = -4
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_CONTEXTHELP = &H400
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const GW_CHILD = 5
Private Const MK_LBUTTON = &H1
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_SYSCOMMAND = &H112
Private Const WM_CLOSE As Long = &H10
Private Const SC_CLOSE = &HF060&
Private Const SWP_SHOWWINDOW = &H40
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const POINTS_PER_INCH = 72
 
Private dblTextboxwidth As Double
Private oTextBox As Object
Private bHookEnabled As Boolean



Public Sub StoreTextboxWidth(ByVal Textbox As Object)
    Set oTextBox = Textbox
    dblTextboxwidth = Textbox.Width
End Sub

Public Sub ShowForm(ByVal Frm As Object, ByVal Show As Boolean)

    Call SetActiveWindow(Application.hwnd)
    Call ShowWindow(hwndFrm, -CLng(Show))
    If Frm.Tag Then EnableWindow Application.hwnd, 0
    If Show = False Then ActiveWindow.RangeSelection.Cells(1).Select

 End Sub

Public Function IsFormModal(Frm As Object) As Boolean

    IsFormModal = Not CBool(SetFocus(Application.hwnd))
    Call WindowFromAccessibleObject(Frm, hwndFrm)
    Call SetFocus(hwndFrm)
    
End Function

Public Sub ShowRefEdit(Dummy As Boolean)
 
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim lVBEhwnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim lVBEhwnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Dim sBuffer As String
    Dim lRet As Long
    
    lVBEhwnd = FindWindow("wndclass_desked_gsk", vbNullString)
    Call ShowWindow(lVBEhwnd, 0)
    sBuffer = VBA.Space(256)
    lRet = GetWindowText(hwndFrm, sBuffer, 256)
    If Not bHookEnabled Then
        lhHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
        bHookEnabled = True
        DoEvents
        Application.Dialogs(xlDialogGoalSeek).Show
    End If
 
End Sub
 
Private Sub TerminateHook()

    Call UnhookWindowsHookEx(lhHook)
    bHookEnabled = False
    
End Sub
 
 
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
     Dim lp As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim lp As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
    Dim tFrmRect As RECT, tRefRect As RECT
    Dim p1 As POINTAPI, p2 As POINTAPI
    Dim sBuffer As String
    Dim PixelPerInch As Single
    Dim lRet As Long
 
    If idHook = HCBT_ACTIVATE Then
        sBuffer = VBA.Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If VBA.Left(sBuffer, lRet) = "bosa_sdm_XL9" Then
            Call TerminateHook
            RefEditHwnd = GetWindow(wParam, GW_CHILD)
            Call GetWindowRect(hwndFrm, tFrmRect)
            Call GetWindowRect(RefEditHwnd, tRefRect)
            With tRefRect
                p1.x = .Left: p1.y = .Top
                p2.x = .Right + 15: p2.y = .Bottom
            End With
            Call ScreenToClient(wParam, p1)
            Call ScreenToClient(wParam, p2)
            lp = MakeLong_32_64(p2.x, p1.y)
            With tFrmRect
                Call SetWindowPos(wParam, Application.hwnd, .Left, .Top, PTtoPX(dblTextboxwidth, False), 0, 0 + SWP_SHOWWINDOW)
            End With
            Call SetWindowLong(wParam, GWL_EXSTYLE, GetWindowLong(wParam, GWL_EXSTYLE) And Not WS_EX_CONTEXTHELP)
            Call PostMessage(RefEditHwnd, WM_LBUTTONDOWN, MK_LBUTTON, lp)
            Call PostMessage(RefEditHwnd, WM_LBUTTONUP, MK_LBUTTON, lp)
            lPrvWndProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf CallBack)
        End If
    End If
 
    HookProc = CallNextHookEx(lhHook, idHook, ByVal wParam, ByVal lParam)
 
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function CallBack(ByVal hwnd As LongPtr, ByVal MSG As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function CallBack(ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
    Dim tWinpos As WINDOWPOS
    Dim sBuffer1 As String, sBuffer2 As String, sBuffer3 As String
    Dim lRet1 As Long, lRet2 As Long, lRet3 As Long
    
    If GetFocus <> hwnd Then Call SetFocus(hwnd)
     
    sBuffer1 = VBA.Space(256): sBuffer2 = VBA.Space(256)
    lRet1 = GetWindowText(RefEditHwnd, sBuffer1, 256): lRet2 = GetWindowText(hwnd, sBuffer2, 256)
   
    If InStr(1, VBA.Left(sBuffer1, lRet1), "!") = 0 Then
        Call SetWindowText(RefEditHwnd, ActiveSheet.Name & "!" & VBA.Left(sBuffer1, lRet1))
    End If
    
    If VBA.Left(sBuffer2, lRet2) <> "RefEditEx" Then
        Call SetWindowText(hwnd, "RefEditEx")
    End If
    
    If GetAsyncKeyState(VBA.vbKeyEscape) Or GetAsyncKeyState(VBA.vbKeyReturn) Or _
        GetAsyncKeyState(VBA.vbKeySeparator) Then
        sBuffer3 = VBA.Space(256)
        lRet3 = GetWindowText(RefEditHwnd, sBuffer3, 256)
        oTextBox.Text = VBA.Left(sBuffer3, lRet3)
        PostMessage hwnd, WM_CLOSE, 0, 0
    End If

    Select Case MSG
        Case Is = WM_WINDOWPOSCHANGING
            Call CopyMemory(tWinpos, ByVal lParam, Len(tWinpos))
            Call CopyMemory(ByVal lParam, tWinpos, Len(tWinpos))
            
        Case Is = WM_SYSCOMMAND
            If wParam = SC_CLOSE Then
                ShowWindow hwnd, 0
                Call SetActiveWindow(Application.hwnd)
                Call PostMessage(hwnd, WM_CLOSE, 0, 0)
                oTextBox.Text = VBA.Left(sBuffer1, lRet1)
            End If
            
        Case WM_LBUTTONDOWN, WM_LBUTTONUP
            Call SetActiveWindow(Application.hwnd)
            Call PostMessage(hwnd, WM_CLOSE, 0, 0)
            oTextBox.Text = VBA.Left(sBuffer1, lRet1)
            
        Case Is = WM_CLOSE
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrvWndProc)
            Call SetTimer(Application.hwnd, 0, 0, AddressOf SelectRange)
    End Select

    CallBack = CallWindowProc(lPrvWndProc, hwnd, MSG, wParam, ByVal lParam)
 
End Function


Private Sub SelectRange()
    Call KillTimer(Application.hwnd, 0)
    On Error Resume Next
    Range(oTextBox.Text).Select
    Debug.Print "Selection: "; Range(oTextBox.Text).Address(, , , True)
End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
    Function MakeLong_32_64(ByVal wLow As Long, ByVal wHigh As Long) As LongPtr
    Dim retVal As LongPtr, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 4
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 4
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 8
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function MakeLong_32_64(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
    Dim retVal As Long, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 2
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 2
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 4
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    End Function
    
    Private Function ScreenDPI(bVert As Boolean) As Long
    Static lDPI(1), lDC
    
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function
 
Private Function PTtoPX(Points As Double, bVert As Boolean) As Long
    PTtoPX = Points * ScreenDPI(bVert) / POINTS_PER_INCH
End Function
 
Upvote 0
Hi Jaafar,

Thank you again for this great project. Also, the gif is very helpful. In the gif you show UserForm1 completely disappearing. On my system: Office 2016 32-bit Windows 10 64-bit UserForm1 doesn't completely disappear it blanks out and becomes "white" but is still in front of the Excel Session.

Also, I have noticed that a consequence of using the GoalSeek dialog is that by default, when the input box loads it defaults to a single cell input, because the selection for GoalSeek is only valid for a single cell.

Thank you,

Daniel.
 
Upvote 0
On my system: Office 2016 32-bit Windows 10 64-bit UserForm1 doesn't completely disappear it blanks out and becomes "white" but is still in front of the Excel Session.

Also, I have noticed that a consequence of using the GoalSeek dialog is that by default, when the input box loads it defaults to a single cell input, because the selection for GoalSeek is only valid for a single cell.

I tested the code on a similar system today (ie: Office 2016 32-bit Windows 10 64-bit ) and I didn't experience the issue you described regarding the form blanking out.

Try the following new update and see if making the form transparent makes a difference:
New workbook update example.

As for the GoalSeek dialog defaulting to a single cell input, as you said, it is valid for a single cell ... The closest I could get (not quite the same) is by commenting out the following line in the
ShowForm public Sub :
Code:
 [COLOR=#008000]'ActiveWindow.RangeSelection.Cells(1).Select[/COLOR]

In this new update, I have also added code to lock the GoalSeek editbox for keyboard inmput so that the user cannot accidently enter wrong data and cause disruption.



Update of the API code module:
Code:
Option Explicit 

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type WINDOWPOS
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        hwnd As LongPtr
        hWndInsertAfter As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        hwnd As Long
        hWndInsertAfter As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
        x As Long
        y As Long
        cx As Long
        cy As Long
        flags As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    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 Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) 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 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 GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hKBhook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hKBhook As LongPtr) As Long
    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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long
    Private Declare PtrSafe Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal fEnable As Long) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As LongPtr, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPtr

    Private hCBTHook As LongPtr, hKBhook As LongPtr, lPrvWndProc As LongPtr, RefEditHwnd As LongPtr, hwndFrm As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC 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 Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) 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 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 GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hKBhook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hKBhook 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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function GetFocus Lib "user32" () As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

    Private hCBTHook As Long, hKBhook As Long, lPrvWndProc As Long, RefEditHwnd As Long, hwndFrm As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const GWL_WNDPROC = -4
Private Const GWL_EXSTYLE = (-20)
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD = 2
Private Const WS_EX_CONTEXTHELP = &H400
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const GW_CHILD = 5
Private Const MK_LBUTTON = &H1
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_SYSCOMMAND = &H112
Private Const WM_CLOSE As Long = &H10
Private Const SC_CLOSE = &HF060&
Private Const SWP_SHOWWINDOW = &H40
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const POINTS_PER_INCH = 72
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&

Private dblTextboxwidth As Double
Private oTextBox As Object



Public Sub StoreTextboxWidth(ByVal Textbox As Object)
    Set oTextBox = Textbox
    dblTextboxwidth = Textbox.Width
End Sub


Public Sub ShowForm(ByVal Frm As Object, ByVal Show As Boolean)

    Call SetWindowLong(hwndFrm, GWL_EXSTYLE, GetWindowLong(hwndFrm, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(hwndFrm, 0, IIf(Show = False, 0, 255), LWA_ALPHA)
    Call SetActiveWindow(Application.hwnd)
    Call ShowWindow(hwndFrm, -CLng(Show))
    If Frm.Tag Then EnableWindow Application.hwnd, 0
    
    If Show = False Then
        If hKBhook = 0 Then
            hKBhook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, _
            GetModuleHandle(vbNullString), GetCurrentThreadId)
        End If
        ActiveWindow.RangeSelection.Cells(1).Select
    Else
        Call UnhookWindowsHookEx(hKBhook)
        hKBhook = 0
    End If

 End Sub


Public Function IsFormModal(Frm As Object) As Boolean

    IsFormModal = Not CBool(SetFocus(Application.hwnd))
    Call WindowFromAccessibleObject(Frm, hwndFrm)
    Call SetFocus(hwndFrm)
    
End Function


Public Sub ShowRefEdit(Dummy As Boolean)
 
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim lVBEhwnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim lVBEhwnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Dim sBuffer As String
    Dim lRet As Long
    
    lVBEhwnd = FindWindow("wndclass_desked_gsk", vbNullString)
    Call ShowWindow(lVBEhwnd, 0)
    sBuffer = VBA.Space(256)
    lRet = GetWindowText(hwndFrm, sBuffer, 256)
    If hCBTHook = 0 Then
        hCBTHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
        DoEvents
        Application.Dialogs(xlDialogGoalSeek).Show
    End If
 
End Sub
 

Private Sub TerminateHook()

    Call UnhookWindowsHookEx(hCBTHook)
    hCBTHook = 0
    
End Sub
 
 
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
     Dim lp As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim lp As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
    Dim tFrmRect As RECT, tRefRect As RECT
    Dim p1 As POINTAPI, p2 As POINTAPI
    Dim sBuffer As String
    Dim PixelPerInch As Single
    Dim lRet As Long
 
    If idHook = HCBT_ACTIVATE Then
        sBuffer = VBA.Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If VBA.Left(sBuffer, lRet) = "bosa_sdm_XL9" Then
            Call TerminateHook
            RefEditHwnd = GetWindow(wParam, GW_CHILD)
            Call GetWindowRect(hwndFrm, tFrmRect)
            Call GetWindowRect(RefEditHwnd, tRefRect)
            With tRefRect
                p1.x = .Left: p1.y = .Top
                p2.x = .Right + 15: p2.y = .Bottom
            End With
            Call ScreenToClient(wParam, p1)
            Call ScreenToClient(wParam, p2)
            lp = MakeLong_32_64(p2.x, p1.y)
            With tFrmRect
                Call SetWindowPos(wParam, Application.hwnd, .Left, .Top, _
                PTtoPX(dblTextboxwidth, False), 0, SWP_SHOWWINDOW)
            End With
            Call SetWindowLong(wParam, GWL_EXSTYLE, _
            GetWindowLong(wParam, GWL_EXSTYLE) And Not WS_EX_CONTEXTHELP)
            Call PostMessage(RefEditHwnd, WM_LBUTTONDOWN, MK_LBUTTON, lp)
            Call PostMessage(RefEditHwnd, WM_LBUTTONUP, MK_LBUTTON, lp)
            lPrvWndProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf CallBack)
        End If
    End If
 
    HookProc = CallNextHookEx(hCBTHook, idHook, ByVal wParam, ByVal lParam)
 
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function KeyboardProc(ByVal ncode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function KeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


    If ncode = HC_ACTION Then
        If GetAsyncKeyState(VBA.vbKeyShift) = 0 Xor _
         GetAsyncKeyState(VBA.vbKeyEscape) = 0 Xor GetAsyncKeyState(VBA.vbKeyReturn) = 0 Then
            KeyboardProc = -1
            Exit Function
        End If
    End If


    KeyboardProc = CallNextHookEx(hKBhook, ncode, wParam, lParam)
    
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function CallBack(ByVal hwnd As LongPtr, ByVal MSG As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function CallBack(ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
    Dim tWinpos As WINDOWPOS
    Dim sBuffer1 As String, sBuffer2 As String, sBuffer3 As String
    Dim lRet1 As Long, lRet2 As Long, lRet3 As Long
    
    If GetFocus <> hwnd Then Call SetFocus(hwnd)
     
    sBuffer1 = VBA.Space(256): sBuffer2 = VBA.Space(256)
    lRet1 = GetWindowText(RefEditHwnd, sBuffer1, 256): lRet2 = GetWindowText(hwnd, sBuffer2, 256)
   
    If InStr(1, VBA.Left(sBuffer1, lRet1), "!") = 0 Then
        Call SetWindowText(RefEditHwnd, ActiveSheet.Name & "!" & VBA.Left(sBuffer1, lRet1))
    End If
    
    If VBA.Left(sBuffer2, lRet2) <> "RefEditEx" Then
        Call SetWindowText(hwnd, "RefEditEx")
    End If
    
     If GetAsyncKeyState(VBA.vbKeyEscape) Or GetAsyncKeyState(VBA.vbKeyReturn) Or _
        GetAsyncKeyState(VBA.vbKeySeparator) Then
        sBuffer3 = VBA.Space(256)
        lRet3 = GetWindowText(RefEditHwnd, sBuffer3, 256)
        oTextBox.Text = VBA.Left(sBuffer3, lRet3)
        PostMessage hwnd, WM_CLOSE, 0, 0
    End If

    Select Case MSG
        Case Is = WM_SYSCOMMAND
            If wParam = SC_CLOSE Then
                ShowWindow hwnd, 0
                Call SetActiveWindow(Application.hwnd)
                Call PostMessage(hwnd, WM_CLOSE, 0, 0)
                oTextBox.Text = VBA.Left(sBuffer1, lRet1)
            End If
            
        Case WM_LBUTTONDOWN, WM_LBUTTONUP
            Call SetActiveWindow(Application.hwnd)
            Call PostMessage(hwnd, WM_CLOSE, 0, 0)
            oTextBox.Text = VBA.Left(sBuffer1, lRet1)
            
        Case Is = WM_CLOSE
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrvWndProc)
            Call SetTimer(Application.hwnd, 0, 0, AddressOf SelectRange)
    End Select

    CallBack = CallWindowProc(lPrvWndProc, hwnd, MSG, wParam, ByVal lParam)
 
End Function


Private Sub SelectRange()
    Call KillTimer(Application.hwnd, 0)
    On Error Resume Next
    Range(oTextBox.Text).Select
    Debug.Print "Selection: "; Range(oTextBox.Text).Address(, , , True)
End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
    Function MakeLong_32_64(ByVal wLow As Long, ByVal wHigh As Long) As LongPtr
    Dim retVal As LongPtr, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 4
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 4
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 8
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function MakeLong_32_64(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
    Dim retVal As Long, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 2
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 2
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 4
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    End Function
    
Private Function ScreenDPI(bVert As Boolean) As Long
    Static lDPI(1), lDC
    
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function

 
Private Function PTtoPX(Points As Double, bVert As Boolean) As Long
    PTtoPX = Points * ScreenDPI(bVert) / POINTS_PER_INCH
End Function
 
Upvote 0

Forum statistics

Threads
1,223,276
Messages
6,171,139
Members
452,381
Latest member
Nova88

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