Option Explicit

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Declare Function SendMessageLong Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const GW_CHILD As Long = 5
Private Const CB_SETITEMHEIGHT As Long = &H153

Private Sub Form_Load()
   SetComboHeight 675
End Sub

Private Sub SetComboHeight(ByVal p_HeightTwips As Long)
   Dim l_Hwnd As Long
   Dim lt_EditRect As RECT
   Dim lt_Pt As POINTAPI
   Dim lt_Pt2 As POINTAPI
   Dim l_YOffset As Long
   Dim l_FontHeight As Long
   Dim lo_OldFont As StdFont
      
   On Error GoTo ErrorHandler

   SendMessageLong Me.ComboBox1.hwnd, CB_SETITEMHEIGHT, -1, p_HeightTwips / Screen.TwipsPerPixelY - 6

   l_Hwnd = GetWindow(Me.ComboBox1.hwnd, GW_CHILD)

   If l_Hwnd <> 0 Then
      GetWindowRect l_Hwnd, lt_EditRect
   
      lt_Pt.x = 3
      lt_Pt.y = 1
   
      lt_Pt2.x = lt_EditRect.Right - lt_EditRect.Left - lt_Pt.x * 2
      lt_Pt2.y = lt_EditRect.Bottom - lt_EditRect.Top - 2
   
      Set lo_OldFont = Me.Font
      Set Me.Font = Me.ComboBox1.Font
      l_FontHeight = Me.TextHeight(Me.ComboBox1.Text)
      Set Me.Font = lo_OldFont
      
      l_YOffset = (p_HeightTwips - l_FontHeight) \ 2 \ Screen.TwipsPerPixelY
   
      SetWindowPos l_Hwnd, 0, lt_Pt.x, lt_Pt.y + l_YOffset - 1, lt_Pt2.x + 1, lt_Pt2.y - (l_YOffset - 2), 0
   End If

   Exit Sub
   
   
ErrorHandler:
   Debug.Print Err.Description
End Sub