Option Explicit



'// Set up the API's

Private Declare Function GetWindowDC Lib "user32" ( _

    ByVal hwnd As Long) As Long



Private Declare Function GetTextExtentPoint32 Lib "gdi32" _

    Alias "GetTextExtentPoint32A" ( _

    ByVal hdc As Long, _

    ByVal lpsz As String, _

    ByVal cbString As Long, _

    lpSize As POINTAPI) As Long



Private Declare Function SendMessage Lib "user32" _

    Alias "SendMessageA" ( _

    ByVal hwnd As Long, _

    ByVal wMsg As Long, _

    ByVal wParam As Long, _

    ByVal lParam As Long) 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 FindWindowA Lib "user32" ( _

    ByVal lpClassName As String, _

    ByVal lpWindowName As String) As Long



Private Declare Function GetSystemMetrics Lib "user32.dll" ( _

    ByVal nIndex As Long) As Long



Public Type POINTAPI

    x As Long

    y As Long

End Type



'// Define Scrn Constants

Private Const SM_CXSCREEN = 0



'// Define ComboBox Constants

Private Const CB_SETDROPPEDWIDTH = &H160

Private Const CB_GETDROPPEDWIDTH = &H15F



'// Define Message

Private Const msg As String = "Could NOT set the NameBox width!"



'// Define some Class Constants

Private Const strDropBtnClass  As String = "ComboBox" 'Name Box Class

Private Const strXLClass       As String = "XLMAIN"   'Main Xl Window Class

Private Const strXLChildClass  As String = "EXCEL;"   'FormulaBar Class



Public Sub ReSizeNameBoxWidth()

'//////////////////////////////////////////////////////

'// Resize the Excel Name Box [ComboBox dropdown width]

'// Developement Enviroment:

'//                        : Excel2000 / Win 98

'//                        : Excel2000 / WinXp(Home)

'// Created by Ivan F Moala 15th September 2002

'// Tests:

'//     Tested Excel XP and XL2000 on WinMe

'//         By Juan Pablo G.

'//         MrExcel.com Consulting

'//         Tom Utis MrExcel MVP

'//     Tested XL 2002 on Windows 2000 SP-3

'//            Windows Me - Swedish

'//            Windows 2000 - Swedish SP-3

'//            Windows XP - Swedish

'//            Excel -versions:

'//            XL 97 SR2b - Swedish

'//            XL 2000 SP-1 - Swedish

'//            XL 2002 SP-2 - English / Swedish.

'//            Test result: No error reported

'// Wishlist:

'// That the namebox lenght adjust automatically to

'// the longest used named.

'//         By XL Dennis

'// Amended 21st Dec 2002 automatically set width to

'// longest string (NOT dynamically!)

'//////////////////////////////////////////////////////



Dim hwndXl As Long               '// Child window that contains combobox

Dim xlMain As Long               '// Xl Window handle

Dim hwndcbo As Long              '// Handle of Name Box dropdown

Dim lSetWidth As Long            '// setting for new width

Dim lScrnWidth As Long           '// Screen Width

Dim Ret As Long                  '// Return Function success variable



'//

Dim lSetH As Long



'// Get Xls handle ie. Main Wnd

xlMain = FindWindowA(strXLClass, vbNullString)



'// Get Child Wnd

hwndXl = FindWindowEx(xlMain, 0, strXLChildClass, vbNullString)



'// NOW Get Handle of the Name Box

hwndcbo = FindWindowEx(hwndXl, 0, strDropBtnClass, vbNullString)



lScrnWidth = GetSystemMetrics(SM_CXSCREEN)



'// Need to look @ 0.89 scale factor!?

lSetWidth = (GetcboxTxtLen(hwndcbo) * 0.89) + 10

'// In case > screen width!

If lSetWidth > lScrnWidth Then

    lSetWidth = lScrnWidth

End If



Ret = SendMessage(hwndcbo, CB_SETDROPPEDWIDTH, lSetWidth, 0)

If Ret = 0 Then MsgBox msg, vbInformation



End Sub



Function GetcboxTxtLen(cboxhnd As Long) As Long

Dim strNames As String

Dim aNames()

Dim ind As Integer

Dim DC As Long

Dim Tmp As Long

Dim TextLargest As Long

Dim TextSize As POINTAPI



For ind = 1 To ActiveWorkbook.Names.Count

    ReDim Preserve aNames(ind)

    aNames(ind) = Names(ind).Name

Next

    

For ind = 1 To UBound(aNames)

    '// Get DeviceContext of Combobox

    DC = GetWindowDC(cboxhnd)

    '// Get measurements of Text in pixels

    GetTextExtentPoint32 DC, aNames(ind), Len(aNames(ind)), TextSize

    Tmp = TextSize.x

    If Tmp > TextLargest Then TextLargest = Tmp

Next ind



GetcboxTxtLen = TextLargest



End Function