Extend Name Box

Question

I can manually shorten or lengthen the Name Box (which is just to the left of the Formula Bar) by dragging the "dot" to the right or left. (This also shortens or lengthens the Formula Bar.)

How can I do the adjustment with VBA??

Answer 1

PHEW!!!!

Things that you throw my way!!! :P

When I realized that there are is no native way to achieve what you want, I resorted to the API way but then I was again disappointed because the "Name Box" only exposed WS_CHILDWINDOW, WS_VISIBLE, CBS_DROPDOWN, CBSAUTOHSCROLL and CBS_HASSTRINGS. The "Dot" doesn't even have a handle.

Out of frustration, I started thinking along the lines of what Mark proposed in his answer. The Registry way. It took me some 20 odd mins to find the Registry key. But Alas, that joy also didn't last long when I realized that changing the registry key didn't have any effect till I restarted Excel.

After this there was only one way left Simulation of the mouse. I would have smashed my laptop on the ground if that didn't work!.

I tried with some hardcoded values in the beginning and was happy with the results. So here is the final version...

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Integer, ByVal Y As Integer) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_MOVE = &H1          ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2      ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4        ' left button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000   ' absolute move

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

Dim pos As RECT

Sub Sample()
    Dim hwndExcel    As Long
    Dim hwndPanel    As Long
    Dim hwndCombo    As Long
    Dim dest_x       As Long
    Dim dest_y       As Long
    Dim cur_x        As Long
    Dim cur_y        As Long
    Dim Position     As POINTAPI

    '~~> Get the handle of the Excel Window
    hwndExcel = FindWindow("XLMAIN", Application.Caption)

    If hwndExcel = 0 Then Exit Sub
    'MsgBox "Excel Window Found"

    '~~> Get the handle of the Panel where the Name Box is
    hwndPanel = FindWindowEx(hwndExcel, ByVal 0&, "EXCEL;", vbNullString)

    If hwndPanel = 0 Then Exit Sub
    'MsgBox "Excel Panel Found"

    hwndCombo = FindWindowEx(hwndPanel, ByVal 0&, "Combobox", vbNullString)

    If hwndCombo = 0 Then Exit Sub
    'MsgBox "Excel Name Box Found"

    '~~> Retrieve the dimensions of the bounding rectangle of the
    '~~> specified window. The dimensions are given in screen
    '~~> coordinates that are relative to the upper-left corner of the screen.
    GetWindowRect hwndCombo, pos

    '~~> Get the approx location of the DOT. It is where the Combobox ends
    cur_x = pos.Right
    cur_y = pos.Top + 10

    '~~> New Destination
    dest_x = cur_x + 500 '<~~ Change width here
    dest_y = cur_y

    '~~> Move the cursor to the specified screen coordinates of the DOT.
    SetCursorPos cur_x, cur_y
    Wait 1 '<~~ Wait 1 second

    '~~> Press the left mouse button on the DOT
    mouse_event MOUSEEVENTF_LEFTDOWN, cur_x, cur_y, 0, 0

    '~> Set the new destination. Take cursor there
    SetCursorPos dest_x, dest_y

    '~~> Press the left mouse button again to release it
    mouse_event MOUSEEVENTF_LEFTUP, dest_x, dest_y, 0, 0
    Wait 1

    MsgBox "done"

End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

Instructions

Paste this code in a module and then from the sheet press ALT+F8 and then select Sample and press ALT+R

Tested in Excel 2010

Before

After

Answer 2

As there isn't a NameBox object within VBA Excel.Application I don't think it's possible in native VBA.

You'd have to delve into REGISTRY. The registry key is

Note: Even if you set the value, for it to take effect, you will have to close and open Excel.