By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
446,231 Members | 1,707 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

AddAllToList With Column Headers

Denburt
Expert 100+
P: 1,356
This function was originally created back in the dawn of time, over the years I have made a number of changes and after searching the net I still didn't see 1 that allowed for the use of column headers so I thought I would post one that does.

On the controls property simply click yes or no for Column Headers and off you go.

You can use the Tag property to determine the column and the words displayed.
2;<No Selection>

To help save a click this Function will also select the Item in the list that you just added, this is commented in the lower portion of the function in case you decide to remove it.

If you need further information on the implementation of this function you can find that here:
http://support.microsoft.com/kb/128881


Expand|Select|Wrap|Line Numbers
  1. Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
  2. lngCol As Long, intCode As Integer) As Variant
  3. On Error GoTo Err_AddAllToList
  4.       Static dbs As Database, rst As Recordset
  5.       Static lngDisplayID As Long
  6.       Static intDisplayCol As Integer
  7.       Static strDisplayText As String
  8.       Static ctlVal As String
  9.       Dim intSemiColon As Integer
  10.       Select Case intCode
  11.          Case acLBInitialize
  12.             If lngDisplayID <> 0 Then
  13.                MsgBox "AddAllToList is already in use by another control!"
  14.                AddAllToList = False
  15.                Exit Function
  16.             End If
  17.             If ctl.Tag > "" Then
  18.                 intSemiColon = InStr(ctl.Tag, ";")
  19.                If intSemiColon = 0 Then
  20.                   intDisplayCol = Val(ctl.Tag)
  21.                Else
  22.                   intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
  23.                   strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
  24.                End If
  25.             Else
  26.                 intDisplayCol = 1
  27.                 strDisplayText = "(All)"
  28.             End If
  29.             ctlVal = strDisplayText
  30.             Set dbs = CurrentDb
  31.             Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
  32.             lngDisplayID = Timer
  33.             AddAllToList = lngDisplayID
  34.          Case acLBOpen
  35.             AddAllToList = lngDisplayID
  36.          Case acLBGetRowCount
  37.             On Error Resume Next
  38.             rst.MoveLast
  39.             If ctl.ColumnHeads = True Then
  40.                 AddAllToList = rst.RecordCount + 2
  41.             Else
  42.                 AddAllToList = rst.RecordCount + 1
  43.             End If
  44.          Case acLBGetColumnCount
  45.             AddAllToList = rst.Fields.Count
  46.          Case acLBGetColumnWidth
  47.             AddAllToList = -1
  48.          Case acLBGetValue
  49.             If ctl.ColumnHeads = True Then
  50.                 If lngRow = 0 Then
  51.                         AddAllToList = rst.Fields(lngCol).Name
  52.                 ElseIf lngRow = 1 Then
  53.                     If lngCol = intDisplayCol - 1 Then
  54.                         AddAllToList = strDisplayText
  55.                     Else
  56.                         AddAllToList = Null
  57.                     End If
  58.                 Else
  59.                     rst.MoveFirst
  60.                     rst.Move lngRow - 2
  61.                     AddAllToList = rst(lngCol)
  62.                 End If
  63.             Else
  64.                 If lngRow = 0 Then
  65.                     If lngCol = intDisplayCol - 1 Then
  66.                         AddAllToList = strDisplayText
  67.                     Else
  68.                         AddAllToList = Null
  69.                     End If
  70.                 Else
  71.                     rst.MoveFirst
  72.                     rst.Move lngRow - 1
  73.                     AddAllToList = rst(lngCol)
  74.                 End If
  75.             End If
  76.          Case acLBEnd
  77.             lngDisplayID = 0
  78.             rst.Close
  79. 'The following if statement selects the item in the list that you have just added
  80.             If ctlVal <> "" Then
  81.                 ctl.Value = ctlVal
  82.             End If
  83.             Set rst = Nothing
  84.             Set dbs = Nothing
  85.       End Select
  86. Bye_AddAllToList:
  87.       Exit Function
  88.  
  89. Err_AddAllToList:
  90.     MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
  91.     AddAllToList = False
  92.     Resume Bye_AddAllToList
  93. End Function
May 7 '09 #1
Share this Article
Share on Google+
1 Comment


FishVal
Expert 2.5K+
P: 2,653
Almost the same: MS Access Calculated List
May 8 '09 #2