Just paste this code into any module (this is the desired way) or form. To do this, open up your project and insert a new Module. Change the name of the module to basGeneral and paste this code into the module.
'----------------------------------------------------------------------
'
' Module Name: basTrueDBGrid
' Written By: C&D Programming Corp.
' Create Date: 11/22/97
' Copyright: Copyright 1997 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
' Purpose: Load ValueItem collection in a grid
'
'----------------------------------------------------------------------
Public Sub LoadColumnCombo(DBGrid As TDBGrid, sDBName As String, _
sSQL As String, sColumn As String, sDisplayField As String, _
sValueField As String)
' Create a new ValueItem object
Dim VItem As New ValueItem
' Declare VItems as a ValueItems collection
Dim VItems As ValueItems
' Create database objects we need to get data
Dim Wrk As Workspace
Dim DB As Database
Dim Snap As Recordset
On Error Goto Handler
' Get the ValueItems collection for the column specified
Set VItems = DBGrid.Columns(sColumn).ValueItems
' Open the database and execute the SQL code
Set Wrk = DBEngine.Workspaces(0)
' Open database non-exclusively and read-only
Set DB = Wrk.OpenDatabase(sDBName, False, True)
Set Snap = DB.OpenRecordset(sSQL, dbOpenSnapshot)
Snap.MoveFirst
' Make sure we clear the list
VItems.Clear
' Process all of the data
While Not Snap.EOF
' This property is the value that will be stored in the column
VItem.Value = Snap.Fields(sValueField).Value
' This property is the value that will be displayed to the user in the
' combo box and the cell in the grid.
VItem.DisplayValue = Snap.Fields(sDisplayField).Value
' Add the items to the ValueItems collection and move to the next
' data records
VItems.Add VItem
Snap.MoveNext
Wend
' Enable automatic translation, cycling, and validation
VItems.Translate = True
VItems.CycleOnClick = True
VItems.Validate = True
VItems.Presentation = dbgSortedComboBox
' Clean up our objects
Set VItem = Nothing
Set Snap = Nothing
Set DB = Nothing
Set Wrk = Nothing
Exit Sub
Handler:
' Make sure we clean up on an error
VItems.Clear
Set VItem = Nothing
Set Snap = Nothing
Set DB = Nothing
Set Wrk = Nothing
Err.Raise Err.Number, "basTBGridl.LoadColumnCombo", Err.Description
End Sub