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

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,656
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:
Hi again Jaafar

I should have time this weekend to fully explore your solution. In the meantime can you confirm that your latest link is to your latest version. Because I have tested again today, this time on XL03 XP and I have the same behaviour. I use the 1st RefEdit to choose a range. The address is correctly loaded to the text box. I then invoke the second. The address is correctly stored again but the address in the first gets wiped.

Sorry Jon. I had misunderstood you :oops:

Yes the result you are getting was meant by design and looking back now , I see that it's only logical that when the user selects a range the range address should remain stored in the TextBox.

The problem is easily fixed by just commenting out the line : oTextBox.Text = "" in the TextBoxDropButt*******_DropButt******* Sub in the CRefEdit Class code.

Workbook Update.
 
Upvote 0

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Repost deleted.

There is a problem when posting.The post either doesn't go through or is posted more than once !!!!!
 
Last edited:
Upvote 0
Repost deleted.

There is a problem when posting.The post either doesn't go through or is posted more than once !!!!!
I noticed that a little bit ago. It was around 1:45 PM EST and it said you made the last post at 1:23 PM, but when I was looking through the post I could not find your last post and was wondering what the heck was up? I thought maybe it was deleted and it still was just saying you were the last post. But after your last updates I can see your post at 1:23 PM now. It is really wierd. I haven't been around much lately to notice how or when it happens though.
 
Upvote 0
Sorry Jon. I had misunderstood you :oops:

Yes the result you are getting was meant by design and looking back now , I see that it's only logical that when the user selects a range the range address should remain stored in the TextBox.

The problem is easily fixed by just commenting out the line : oTextBox.Text = "" in the TextBoxDropButt*******_DropButt******* Sub in the CRefEdit Class code.

Workbook Update.

Superb! :)
 
Upvote 0
I noticed that a little bit ago. It was around 1:45 PM EST and it said you made the last post at 1:23 PM, but when I was looking through the post I could not find your last post and was wondering what the heck was up? I thought maybe it was deleted and it still was just saying you were the last post. But after your last updates I can see your post at 1:23 PM now. It is really wierd. I haven't been around much lately to notice how or when it happens though.

That's right schielrn.
Weird posting problems on this thread !

I had already reported it in the About this board forum.
 
Upvote 0
here is a neat implementation of this RefEdit alternative in a userform in which it is used to dynamically select a worksheet range and display the corresponding chart on the form.

Workbook example.

Should work with all excel versions.
 
Upvote 0
generell the solution is great .. but i found 2 small limitations.

a) the change event of the "orginal" textbox is not fired once the "CallBack" - Function update the textbox.
my simple solution is:

Code:
   1) add a additional Event into the class CRefEdit
    -> Public Event OnChange(ByVal sNewText As String)
   2) enhance the Button Click sub in the class with the additional line at the end:  
      "RaiseEvent OnChange(oTextBox.Text)"
   3) change the declaration on the class in the userform to:
      Private WithEvents MyRefEditClass As CRefEdit
   4) now i can "handle" the change event with this:
      Private Sub MyRefEditClass_OnChange(ByVal sNewText As String)
        '...
      End Sub

b) the textbox height of the inputbox is fixed.
The height depends on the systemfont size (unfortunately).

Due to the "small" Size .. the caption of the button ("...") is not visible if you use windows 7.
until now i did not find a proper solution to modify the font size or height of the input control.

therefore i have changed the caption to "-"
Code:
-> lCustomBtnHwnd = CreateWindowEx(WS_EX_CLIENTEDGE, "Button", "-", ...

If you or anyone else find a solution to change the fontsize of the inputbox .. this will be great.
 
Upvote 0
Nice addition adix. I tried it and worked great .

as for the caption of the button ("...") not showing properly , I think the width of the button is the culprit. Try experimenting with the lCustomButtonWidth value inside the HookProc

maybe something along these lines :

lCustomButtonWidth = IIf(Windows7, SomeValuehere, SomeeOtherValuehere)
Not an elegant solution but it can get the job done.

You can easily use the GetVersionEx API to get the Windows version. Thanks for the input.
 
Upvote 0

Forum statistics

Threads
1,216,503
Messages
6,131,020
Members
449,615
Latest member
Nic0la

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