Option Compare Database
Option Explicit
Private WithEvents mTextBox As Access.TextBox
Private WithEvents mListBox As Access.ListBox
Private mHeightPixels As Integer
Private mUpdateTextBox As Boolean
Private mVisibleColumn As Integer
Private WithEvents mForm As Access.Form
Public Sub Initialize(TheTextBox As Access.TextBox, TheListBox As Access.ListBox, Optional HeightInInches = 1, Optional UpdateTextBox As Boolean = True)
Set mTextBox = TheTextBox
Set mListBox = TheListBox
mHeightPixels = HeightInInches * 1440
With mTextBox
.OnMouseDown = "[Event Procedure]"
.OnKeyDown = "[Event Procedure]"
.OnMouseUp = "[Event Procedure]"
.OnKeyUp = "[Event Procedure]"
.Locked = True
End With
With mListBox
.Left = mTextBox.Left
.Height = 0
.Top = mTextBox.Top + mTextBox.Height
.Width = mTextBox.Width
.AfterUpdate = "[Event Procedure]"
.OnMouseDown = "[Event Procedure]"
.OnKeyDown = "[Event Procedure]"
.OnClick = "[Event Procedure]"
End With
Set mForm = TheTextBox.Parent
mForm.OnCurrent = "[Event Procedure]"
mUpdateTextBox = UpdateTextBox
SetVisibleColumn
End Sub
Private Sub SetVisibleColumn()
Dim aWidths() As String
Dim i As Integer
If mListBox.ColumnCount > 0 And mListBox.ColumnWidths <> "" Then
aWidths = Split(mListBox.ColumnWidths, ";")
For i = 0 To UBound(aWidths)
If aWidths(i) <> "0" Then
mVisibleColumn = i
Exit For
End If
Next i
End If
End Sub
Private Sub mForm_Current()
mListBox.Visible = False
End Sub
Private Sub mForm_Load()
End Sub
Private Sub mListBox_AfterUpdate()
If mUpdateTextBox Then mTextBox.Value = mListBox.Column(mVisibleColumn)
'ShrinkList
End Sub
Private Sub mListBox_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
mTextBox.SetFocus
ShrinkList
End If
'Causes some random value to get selected
End Sub
Private Sub mListBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ShrinkList
'For some reason causes the value to not select
End Sub
Private Sub mTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
ExpandList
End Sub
Private Sub mTextBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ExpandList
End Sub
Public Sub ExpandList()
With mListBox
.Height = mHeightPixels
.Top = mTextBox.Top + mTextBox.Height
.Visible = True
.SetFocus
.BorderStyle = 1
End With
End Sub
Public Sub ShrinkList()
With mListBox
'for some strange reason cannot make height very small such as 0. The value will not select every other time.
.Height = 60
.BorderStyle = 0
End With
End Sub