J
JeremyJ
I am trying to have a combobox in a Userform show all of the items with out
having to scroll. I found the below code online but it hangs up at a couple
spots.
Error #1: When Sub SetCBItemsToDisplay is in a standard module it
highlights 'Screen.TwipsPerPixelX' and says 'Object Required'
Error #2: When Sub SetCBItemsToDisplay is in the form code it highlights
'Screen' and says 'Variable not defined'
Error #3: Highlights 'cbo.hwnd' and says 'Object does not support this
property or method'
Option Explicit
Private Const CB_GETITEMHEIGHT = &H154
Private Const CB_SHOWDROPDOWN = &H14F
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long,
lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long,
lpPoint As POINTAPI) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal
x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal bRepaint As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Sub SetCBItemsToDisplay(cbo As ComboBox, ItemsNumber As Long)
Dim ItemHeight As Long
Dim wid As Long
Dim hgt As Long
Dim r As RECT
Dim p As POINTAPI
Dim hParent As Long
ItemHeight = SendMessage(cbo.hwnd, CB_GETITEMHEIGHT, 0&, 0&)
hgt = (ItemsNumber + 2) * ItemHeight
wid = cbo.Width / Screen.TwipsPerPixelX
GetWindowRect cbo.hwnd, r
p.x = r.Left
p.y = r.Top
hParent = GetParent(cbo.hwnd)
ScreenToClient hParent, p
MoveWindow cbo.hwnd, p.x, p.y, wid, hgt, False
End Sub
Option Explicit
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 25
Combo1.AddItem "Item " & i
Next
SetCBItemsToDisplay Combo1, Combo1.ListCount
End Sub
having to scroll. I found the below code online but it hangs up at a couple
spots.
Error #1: When Sub SetCBItemsToDisplay is in a standard module it
highlights 'Screen.TwipsPerPixelX' and says 'Object Required'
Error #2: When Sub SetCBItemsToDisplay is in the form code it highlights
'Screen' and says 'Variable not defined'
Error #3: Highlights 'cbo.hwnd' and says 'Object does not support this
property or method'
Option Explicit
Private Const CB_GETITEMHEIGHT = &H154
Private Const CB_SHOWDROPDOWN = &H14F
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long,
lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long,
lpPoint As POINTAPI) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal
x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal bRepaint As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Sub SetCBItemsToDisplay(cbo As ComboBox, ItemsNumber As Long)
Dim ItemHeight As Long
Dim wid As Long
Dim hgt As Long
Dim r As RECT
Dim p As POINTAPI
Dim hParent As Long
ItemHeight = SendMessage(cbo.hwnd, CB_GETITEMHEIGHT, 0&, 0&)
hgt = (ItemsNumber + 2) * ItemHeight
wid = cbo.Width / Screen.TwipsPerPixelX
GetWindowRect cbo.hwnd, r
p.x = r.Left
p.y = r.Top
hParent = GetParent(cbo.hwnd)
ScreenToClient hParent, p
MoveWindow cbo.hwnd, p.x, p.y, wid, hgt, False
End Sub
Option Explicit
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 25
Combo1.AddItem "Item " & i
Next
SetCBItemsToDisplay Combo1, Combo1.ListCount
End Sub