扩展名称框

Question

我可以通过拖动＆＃34;点＆＃34;手动缩短或延长名称框 （位于公式栏左侧）向右或向左。 （这也会缩短或延长公式栏。）

如何使用VBA进行调整？

Answer 1

由于VBA NameBox中没有Excel.Application对象，我认为在原生VBA中不可能。

你必须深入研究REGISTRY。注册表项是

注意：即使您设置了值，要使其生效，您也必须关闭并打开Excel。

Answer 2

呼!!!!

你扔的东西!!! ：P

当我意识到没有本地方式来实现你想要的东西时，我采用了API方式，但后来我再次感到失望，因为“名称框”只暴露了WS_CHILDWINDOW，WS_VISIBLE ，CBS_DROPDOWN，CBSAUTOHSCROLL和CBS_HASSTRINGS。 “Dot”甚至没有手柄。

出于沮丧，我开始思考马克在答案中提出的建议。 Registry方式。找到注册表项我花了大约20多分钟。但是，当我意识到在重新启动Excel之前更改注册表项没有任何效果时，这种快乐也没有持续多久。

此后只有一条路Simulation of the mouse。如果不起作用，我会把我的笔记本电脑砸在地上！

我在开始时尝试了一些硬编码值，并对结果感到满意。所以这是最终版本......

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

<强>说明

将此代码粘贴到模块中，然后从工作表中按 ALT + F8 ，然后选择Sample并按 ALT + - [R

在Excel 2010中测试

<强>之前

<强>后