Load ComboBox, ListBox from
Database Table
Shows text property of ListBox in ToolTip
'------------------------------------------------------
'Author:Chris O'Leary
'Posted:5/26/98
'coleary@agri.ns.ca
'
'Generic Sub to fill comboboxes, listboxes etc...
'usage: loadbox cboBoxName, "dbTableName", "dbIDField",
'"dbDescriptionField"
'Where: cboBoxName is the combo/listbox you want to populate,
'dbTableName is the database table where you want to populate
'from, dbIDField is the unique Id number for the fields (ie:
'Customer_ID) and dbDescriptionField is a text field (ie: Customer_Name)
'------------------------------------------------------
Public Sub LoadBox(cboBox As Object, strTB, IDField, descField As
String)
On Error GoTo Errors
Dim rs As Recordset 'Declare a recordset
Dim sql As String 'Declare a string to hold the SQL statement
cboBox.Clear
'Clear the combobox in question, in case it isn't
sql = ""
'Clear SQL in case there is another var named SQL somewhere
'Setup SQL to select fields based on the values passed to the function
sql = "SELECT " & IDField & ", " & descField & " FROM " & strTB
'Open the recordset with the data returned by the SQL statement
Set rs = db.OpenRecordset(sql, dbOpenForwardOnly)
With rs
Do Until .EOF 'Loop until the End of the recordset
'Add the items, and thier corresponding ID's
cboBox.AddItem rs(descField)
cboBox.ItemData(cboBox.NewIndex) = rs(IDField)
.MoveNext
Loop
.Close
Debug.Print cboBox.Name & " was populated"
End With '(rs)
Set rs = Nothing 'Release the variable
Exit Sub
Errors: 'Error handler
If Err.Number <> 0 Then
MsgBox ("Error #: " & str(Err.Number) & Err.Description)
Exit Sub
End If
End Sub
'------------------------------------------------------
'Author:Chris O'Leary
'Posted:5/26/98
'coleary@agri.ns.ca
'
'Shows the text property of a listbox in the tooltip property,
'when the mouse hovers over the listbox for a second. Relies
'on the SendMessage API, declared in the API_Routines file.
'------------------------------------------------------
Public Function ShowListTTip(Button As Integer, Shift As Integer, X As
Single, Y As Single, ListBox As ListBox) As String
' Show tool tip message
Dim lXPoint As Long
Dim lYPoint As Long
Dim lIndex As Long
'
If Button = 0 Then ' No button was pressed
'Get the x/y position of the mouse on the screen.
'in "TwipsPerPixel" (X and Y)
lXPoint = CLng(X / Screen.TwipsPerPixelX)
lYPoint = CLng(Y / Screen.TwipsPerPixelY)
'
With ListBox
' find which listbox item the mouse is hovering over.
lIndex = SendMessage(.hWnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint))
' show the tooltip or clear last one, make sure the index is
'greater than or equal to 0 and not greater than the listcount
If (lIndex >= 0) And (lIndex <= .ListCount) Then .ToolTipText=".List(lIndex)" 'Return the text=".list(lIndex)" Else .ToolTipText 'Return nothing
End If
End With '(ListBox)
End If '(button=0)
End Function