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

wsDAH

New Member
Joined
Oct 16, 2019
Messages
11
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,
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

wsDAH

New Member
Joined
Oct 16, 2019
Messages
11
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.
 

Jaafar Tribak

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

wsDAH

New Member
Joined
Oct 16, 2019
Messages
11
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
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
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:

wsDAH

New Member
Joined
Oct 16, 2019
Messages
11
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
 

wsDAH

New Member
Joined
Oct 16, 2019
Messages
11
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.


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?
 

wsDAH

New Member
Joined
Oct 16, 2019
Messages
11
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.


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
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
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:

Watch MrExcel Video

Forum statistics

Threads
1,099,737
Messages
5,470,444
Members
406,699
Latest member
perfectioncts

This Week's Hot Topics

Top