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

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,577
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 Jaafar,

Thank you for engaging on this again I'm learning a lot. A couple of notes. The transparency change doesn't seem to have had an affect. I will try on another system here to see if I see different behavior. Perhaps it is my installation of excel/Add-Ins.

I like the GoalSeek editbox lock that is fun.

I have put the class module and standard Module in a Userform in an Add-in but I'm having an issue when trying to add more than one RefEditTextBox to a single form. Only the RefEdit Box I define last responds to the _DropButt******* event.

Thank you,
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Hi Jaafar,

I have put the class module and standard Module in a Userform in an Add-in but I'm having an issue when trying to add more than one RefEditTextBox to a single form. Only the RefEdit Box I define last responds to the _DropButt******* event.

Thank you,

This is not an issue it was a typo.
 
Upvote 0
The transparency change doesn't seem to have had an affect. I will try on another system here to see if I see different behavior. Perhaps it is my installation of excel/Add-Ins.

Please, do let me know of the outcome when testing the code on another system.

Thank you.
 
Upvote 0
Hi Jaafar,

Please, do let me know of the outcome when testing the code on another system.

I have tested on a Windows 10 64-bit Excel 2013 32-bit system and it works as intended so I'm not sure what is wrong with my system.

I have made some other changes to the code to implement some new features.

1. In HookProc I have added a line of code to check if the inputbox has something that looks like a range in it and if so it will pre-populate the selection box with it
Code:
 If InStr(1, oTextBox.text, "!") > 0 Then Call SetWindowText(RefEditHwnd, oTextBox.text)

2. In CallBack I broke out the Escape Key and modified the SC_CLOSE case to not set the oTExtBox.text property. If this is a bad idea let me know:
Code:
    If 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
    
    If GetAsyncKeyState(VBA.vbKeyEscape) Then
        sBuffer3 = VBA.Space(256)
        lRet3 = GetWindowText(RefEditHwnd, sBuffer3, 256)
        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
 
Upvote 0
I have tested on a Windows 10 64-bit Excel 2013 32-bit system and it works as intended so I'm not sure what is wrong with my system.
I too have tested the code in various machines and it works as intended in all of them.

I have made some other changes to the code to implement some new features.
1- Where exactly in the HookProc did you add the line ?
Code:
    If InStr(1, oTextBox.Text, "!") > 0 Then Call SetWindowText(RefEditHwnd, oTextBox.Text)

In CallBack I broke out the Escape Key and modified the SC_CLOSE case to not set the oTExtBox.text property. If this is a bad idea let me know
2- I think, breaking out the ESC key is a good idea as it is the key that is normally associated with a Cancel operation... I'll amend the code in the workbook demo to accomodate your modification.

I would just remove the buffer and GetWindowTex lines and leave the following:
Code:
    If GetAsyncKeyState(VBA.vbKeyEscape) Then
        PostMessage hwnd, WM_CLOSE, 0, 0
    End If

Regards.
 
Last edited:
Upvote 0
1- Where exactly in the HookProc did you add the line ?
Code:
    If InStr(1, oTextBox.Text, "!") > 0 Then Call SetWindowText(RefEditHwnd, oTextBox.Text)

I apologize for the lack of clarity there below is my new HookProc

Code:
#If 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)
            If InStr(1, oTextBox.text, "!") > 0 Then Call SetWindowText(RefEditHwnd, oTextBox.text) 'This is what puts the current text of the inputbox into the refedit box if there is an "!" in the string
            lPrvWndProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf CallBack)
        End If
    End If
 
    HookProc = CallNextHookEx(hCBTHook, idHook, ByVal wParam, ByVal lParam)
 
End Function
 
Upvote 0
Hi Jaafar,

I have another issue I'm trying to solve. When the RefEdit box returns, it puts the text into the textbox, but it doesn't trigger the _change event for that textbox. I would like to evaluate the contents of the range and put that in an adjacent label when the textbox input is changed. Similar to the "Edit Series" box when selecting chart data.
imgres
7a976dea-d4a5-479f-a85c-8e43de643583.png


I was going to use the change event for each textbox, but I'm not sure how to get that to be triggered. Any ideas?
 
Upvote 0
Hi Jaafar,

I have another issue I'm trying to solve. When the RefEdit box returns, it puts the text into the textbox, but it doesn't trigger the _change event for that textbox. I would like to evaluate the contents of the range and put that in an adjacent label when the textbox input is changed. Similar to the "Edit Series" box when selecting chart data.
imgres
7a976dea-d4a5-479f-a85c-8e43de643583.png


I was going to use the change event for each textbox, but I'm not sure how to get that to be triggered. Any ideas?


Answering my own question, I have updated the CRefEdit class module to have some new properties which requires a little bit extra setup:
1. You must define the label in your userform which should be this RefEdit's .TextShow Property
2. in the _Change event for each textbox you should call the CRefEdit(of that text box).SetLabel to update your label.
3. Figure out what the correct target.Width is (hard coded at 110 right now)

New CRefEdit code:
Code:
Option Explicit


Private WithEvents oTextBox As MSForms.TextBox
Private oUF As Object
Private oLabel As Object


Public Property Set UserForm(ByVal Frm As Object)
    Set oUF = Frm
    Frm.Tag = IsFormModal(Frm)
End Property


Public Property Set TextShow(ByVal Lbl As Object)
    Set oLabel = Lbl
End Property


Public Property Get text() As String
    text = oTextBox.text
End Property
 
Public Sub TransformTextBoxIntoRefEdit(ByVal TextBox As Object)
    Set oTextBox = TextBox
    TextBox.DropButtonStyle = fmDropButtonStyleReduce
    TextBox.ShowDropButtonWhen = fmShowDropButtonWhenAlways
End Sub
 
Public Sub oTextBox_DropButt*******()
    Call StoreTextboxWidth(oTextBox)
    Call ShowForm(oUF, False)
    Call ShowRefEdit(True)
    Call ShowForm(oUF, True)
    Me.SetLabel
End Sub


Public Sub SetLabel()
    UpdateLabelCaption oLabel, oTextBox.text
End Sub


Private Sub UpdateLabelCaption(ByRef target As MSForms.Label, ByVal text As String)
    Dim k As Long
    Dim sChar As String
    Dim newString As String
    newString = ""
    If text <> "" Then
        For k = 1 To Len(text)
            sChar = Mid(text, k, 1)
            newString = newString + sChar
            target.Caption = "= " & newString
            target.AutoSize = True
            If target.Width > 110 Then
                target.Caption = target.Caption & "..."
                target.AutoSize = True
                Exit For
            End If
        Next k
    Else
        target.Caption = "= "
    End If
End Sub
 
Upvote 0
New Workbook Update.

I would prefer leaving the Class Module code untouched and would just do the following:


1- Add to the main API standard Module a new routine named : RaiseTextBoxChangeEvent and call it from the SelectRange Sub.

API Module:
Code:
Private Sub SelectRange()

    Call KillTimer(Application.hwnd, 0)
    On Error Resume Next
    Range(oTextBox.text).Select
    Debug.Print "Selection: "; Range(oTextBox.text).Address(, , , True)    
    [COLOR=#ff0000]Call RaiseTextBoxChangeEvent[/COLOR]
    
End Sub


Private Sub RaiseTextBoxChangeEvent()

    Dim sTempTextBoxTag As String
    
    With oTextBox
        sTempTextBoxTag = .text
        .Tag = 1
        .text = ""
        .Tag = ""
        .text = sTempTextBoxTag
    End With

End Sub


2- In the UserForm Module, I would use the TxtBox Change Event as follows:
( Change the names of the TextBox and Label controls as needed )

Code:
Private Sub TextBox1_Change()

    If Len(TextBox1.Tag) = 0 Then
        Label3.Caption = Label3.Caption & TextBox1.text
    End If

End Sub

I think this method is easier more flexible and more intuitive.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,142
Members
448,551
Latest member
Sienna de Souza

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