Page 1 of 2 12 LastLast
Results 1 to 10 of 20

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

This is a discussion on Cool RefEdit Alternative - (Made with a standard TextBox !) within the Excel Questions forums, part of the Question Forums category; Hi all. In a previous thread , our member Jon Von Der Heyden kindly brought my attention to this recent ...

  1. #1
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    5,711

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

    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
                                 'Remove the Red *
    Private Sub TextBoxDropButton_Click_DropButton*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
     
    '\\ Private declarations.
    '=========================
    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
     
    '\\ Public declarations.
    '=========================
    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 by Jaafar Tribak; May 2nd, 2010 at 04:18 AM.
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  2. #2
    MrExcel MVP
    Moderator

    Tracy's new best bud
    Jon von der Heyden's Avatar
    Join Date
    Apr 2004
    Location
    Blackboys, East Sussex, UK
    Posts
    10,535

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

    Sheer beauty Jaafar! Good job!
    Definitely something I see myself using in the future.

    Works in XL07 too, using Vista Home
    Regards,
    Jon von der Heyden

    Posting guidelines | Forum rules | FAQs

    Blog: Excel Evolution Blog | Twitter: @ExcelEvo | Facebook: Follow me here

    English is a weird language. It can be understood through tough thorough thought, though!

  3. #3
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    5,711

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

    Thanks Jon for the feedback. Glad it worked on XL 07 - Vista too.

    Jon Peltier kindly brought to my attention a problem when using multiple TextBoxes in a userform. The selected range address showed only in one TextBox.

    HERE is an update that corrects the above problem when using multiple TextBoxes.
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  4. #4
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    5,711

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

    Sorry. Repost deleted.
    Last edited by Jaafar Tribak; May 3rd, 2010 at 03:45 AM.
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  5. #5
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    5,711

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

    A couple of issues fixed with Multi-RefEdits .

    Update here.
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  6. #6
    MrExcel MVP
    Moderator

    Tracy's new best bud
    Jon von der Heyden's Avatar
    Join Date
    Apr 2004
    Location
    Blackboys, East Sussex, UK
    Posts
    10,535

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

    Hi Jaafar

    I've just taken a brief look again, using XL07 on Vista Home.

    I haven't taken the time to go through the code but on initial test the RefEdit controls are not preserving the range addresses when another is subsequently invoked.

    But I'm think I can figure it out. This is great!
    Regards,
    Jon von der Heyden

    Posting guidelines | Forum rules | FAQs

    Blog: Excel Evolution Blog | Twitter: @ExcelEvo | Facebook: Follow me here

    English is a weird language. It can be understood through tough thorough thought, though!

  7. #7
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    5,711

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

    Thanks jon for taking a look at this.

    I haven't taken the time to go through the code but on initial test the RefEdit controls are not preserving the range addresses when another is subsequently invoked.
    I just re-tested the workbook example and it worked as expected.
    I had also sent the same workbook example to Jon Peltier and he didn't report any problems.
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  8. #8
    MrExcel MVP tusharm's Avatar
    Join Date
    May 2002
    Posts
    11,007

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

    The approach I have taken for a long time now is, IMO, much more straightforward.
    Range references in a userform
    http://www.tushar-mehta.com/publish_..._in_a_userform

    Quote Originally Posted by Jaafar Tribak View Post
    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
                                 'Remove the Red *
    Private Sub TextBoxDropButton_Click_DropButton*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
     
    '\\ Private declarations.
    '=========================
    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
     
    '\\ Public declarations.
    '=========================
    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.

  9. #9
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    5,711

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

    Quote Originally Posted by tusharm View Post
    The approach I have taken for a long time now is, IMO, much more straightforward.
    Range references in a userform
    http://www.tushar-mehta.com/publish_..._in_a_userform
    Hi Tushar.

    Thanks for sharing your valuable work.

    I built a userform based on your approach and as you said, it is more straightforward but it is far less user intuitive.

    IMO,other than getting a worksheet range, It is has no ressemblance with the RefEdit Control .
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  10. #10
    MrExcel MVP
    Moderator

    Tracy's new best bud
    Jon von der Heyden's Avatar
    Join Date
    Apr 2004
    Location
    Blackboys, East Sussex, UK
    Posts
    10,535

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

    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.
    Regards,
    Jon von der Heyden

    Posting guidelines | Forum rules | FAQs

    Blog: Excel Evolution Blog | Twitter: @ExcelEvo | Facebook: Follow me here

    English is a weird language. It can be understood through tough thorough thought, though!

Page 1 of 2 12 LastLast

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com