Hi Filips,

' Adjust the name box on the longest name:
Private Declare Function FindWindowA& Lib "user32" _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowExA& Lib "user32" _
(ByVal hWnd1&, ByVal hWnd2&, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetWindowDC& Lib "user32" (ByVal hwnd&)
Private Declare Function GetTextExtentPoint32A& Lib _
"gdi32" (ByVal hDC&, ByVal lpsz$, ByVal cbString& _
, lpSize As POINTAPI)
Private Declare Function SendMessageA& Lib "user32" _
(ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)
Private Type POINTAPI
x As Long
y As Long
End Type

' Modify the number of items
Private Declare Function GetClientRect& Lib "user32" _
(ByVal hwnd&, lpRect As RECT)
Private Declare Function MoveWindow& Lib "user32" _
(ByVal hwnd&, ByVal x&, ByVal y&, ByVal nWidth& _
, ByVal nHeight&, ByVal bRepaint&)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Sub AdjustComboNames()
If ActiveWorkbook.Names.Count = 0 Then Exit Sub
Dim hwnd&, iName$, i%, hDC&, Txt As POINTAPI, MaxLen&
hwnd = FindWindowA(vbNullString, Application.Caption)
hwnd = FindWindowExA(hwnd, ByVal 0&, "EXCEL;", vbNullString)
hwnd = FindWindowExA(hwnd, ByVal 0&, "ComboBox", vbNullString)
hDC = GetWindowDC(hwnd)
For i = 1 To ActiveWorkbook.Names.Count
iName = ActiveWorkbook.Names(i).Name
GetTextExtentPoint32A hDC, iName, Len(iName), Txt
If Txt.x MaxLen Then MaxLen = Txt.x
Next i
' Adjust the width on the longest name
SendMessageA hwnd, &H160, MaxLen, 0
' Make the list larger (25 items)
Dim Nb As Byte: Nb = 25
Dim R As RECT: GetClientRect hwnd, R
With R
R.Bottom = Txt.y * (Nb + 2)
MoveWindow hwnd, .Left, .Top, .Right - .Left, (.Bottom - .Top), 1
End With
End Sub

Regards,
MP

"Filips Benoit" a écrit dans le message de news:
...
Dear All,

Is it possible to make the Name Box wider ?

Filip