module:
Option Explicit' These functions required to set the drop-down width:
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160' These are only required if you want to automatically
' calculate the drop-down width:
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_CALCRECT = &H400Public Property Let DropDownWidth(ByRef cboThis As ComboBox, ByVal lWidth As Long)
    SendMessageLong cboThis.hwnd, CB_SETDROPPEDWIDTH, lWidth, 0
End Property
Public Property Get DropDownWidth(ByRef cboThis As ComboBox) As Long
Dim lW As Long
    DropDownWidth = SendMessageLong(cboThis.hwnd, CB_GETDROPPEDWIDTH, 0, 0)
End Property
Public Sub DropDownWidthFromContents(ByRef cboThis As ComboBox, Optional ByVal lMaxWidth = -1)
Dim i As Long
Dim tR As RECT
Dim lW As Long
Dim lWidth As Long
Dim lHDC As Long    ' Evaluate the width of each item in the
    ' combo box:
  'Print
    ' First set the combo's parent form font to the
    ' combo font:
    With cboThis.Parent.Font
        .Name = cboThis.Font.Name
        .Size = cboThis.Font.Size
        .Bold = cboThis.Font.Bold
        ' Surely you don't have a combo box with
        ' italic font?
        .Italic = cboThis.Font.Italic
    End With
    ' Cache the HDC of the parent form for speed:
    lHDC = cboThis.Parent.hdc
  'Print
    ' Loop through each combo box list item & get its
    ' width, storing the largest:
    For i = 0 To cboThis.ListCount - 1
        DrawText lHDC, cboThis.List(i), -1, tR, DT_CALCRECT
        lW = tR.Right - tR.Left + 8
        If (lW > lWidth) Then
            lWidth = lW
        End If
    Next i
  'Print
    ' Don't allow width to exceed specified max
    ' width, or the width of the screen:
    If lMaxWidth <= 0 Then
        lMaxWidth = Screen.Width \ Screen.TwipsPerPixelX - 16
    End If
    If (lWidth > lMaxWidth) Then
        lWidth = lMaxWidth
    End If
  'Print
    ' Combo box looks a bit strange when the
    ' drop down portion is smaller than the
    ' combo box itself:
    If (lWidth < cboThis.Width \ Screen.TwipsPerPixelX) Then
        lWidth = cboThis.Width \ Screen.TwipsPerPixelX
    End If
  'Print
    ' Set the drop down width:
    DropDownWidth(cboThis) = lWidth
End Subform:
Option ExplicitPrivate Sub Command1_Click()
Dim sI As String
    sI = InputBox("Enter string", , "New item")
    If (sI <> "") Then
        Combo1.AddItem sI
    End If
End SubPrivate Sub Command2_Click()
    DropDownWidthFromContents Combo1
    Label1.Caption = DropDownWidth(Combo1)
End SubPrivate Sub Command3_Click()
Dim sI As String
    sI = InputBox("Enter width", , DropDownWidth(Combo1))
    If IsNumeric(sI) Then
        DropDownWidth(Combo1) = CLng(sI)
        Label1.Caption = DropDownWidth(Combo1)
    End If
End SubPrivate Sub Form_Load()
    Label1.Caption = DropDownWidth(Combo1)
End Sub