Oh help!
I'm trying to add the option of choosing "all" to my combo box. My row source is pulling the data correctly from my table and the form works wonderfully. But then when I try to add in my code to add an "All" function, it stops working. Any ideas?
Here's the code I'm using. It came from http://msdn.microsoft.com/en-us/library/bb457185(v=office.12).aspx#Y515:
Function AddAllToList(ctl As Control, lngID As Long, _
lngRow As Long, lngCol As Long, _
intCode As Integer) As Variant
Static dbs As Database, rst As Recordset
Static lngDisplayID As Long
Static intDisplayCol As Integer
Static strDisplayText As String
Dim intSemiColon As Integer
On Error GoTo Err_AddAllToList
Select Case intCode
Case acLBInitialize
' See if function is already in use.
If lngDisplayID <> 0 Then
MsgBox "AddAllToList is already in use!"
AddAllToList = False
Exit Function
End If
' Parse the display column and display text
' from the Tag property.
intDisplayCol = 1
strDisplayText = "(All)"
If Not IsNull(ctl.Tag) And (ctl.Tag <> "") Then
intSemiColon = InStr(ctl.Tag, ";")
If intSemiColon = 0 Then
intDisplayCol = Val(ctl.Tag)
Else
intDisplayCol = _
Val(Left(ctl.Tag, intSemiColon - 1))
strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
End If
End If
' Open the recordset defined in the
' RowSource property.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(ctl.RowSource, _
dbOpenSnapshot)
' Record and return the lngID for this
' function.
lngDisplayID = Timer
AddAllToList = lngDisplayID
Case acLBOpen
AddAllToList = lngDisplayID
Case acLBGetRowCount
' Return number of rows in recordset.
On Error Resume Next
rst.MoveLast
AddAllToList = rst.RecordCount + 1
Case acLBGetColumnCount
' Return number of fields (columns) in recordset.
AddAllToList = rst.Fields.Count
Case acLBGetColumnWidth
AddAllToList = -1
Case acLBGetValue
If lngRow = 0 Then
If lngCol = 0 Or lngCol = intDisplayCol Then
AddAllToList = strDisplayText
End If
Else
rst.MoveFirst
rst.Move lngRow - 1
AddAllToList = rst(lngCol)
End If
Case acLBEnd
lngDisplayID = 0
rst.Close
End Select
Bye_AddAllToList:
Exit Function
Err_AddAllToList:
MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
AddAllToList = False
Resume Bye_AddAllToList
End Function
I then change my row source type to "AddAllToList".
And then the combo box quits working.
Any suggestions would be appreciated!!!
I'm trying to add the option of choosing "all" to my combo box. My row source is pulling the data correctly from my table and the form works wonderfully. But then when I try to add in my code to add an "All" function, it stops working. Any ideas?
Here's the code I'm using. It came from http://msdn.microsoft.com/en-us/library/bb457185(v=office.12).aspx#Y515:
Function AddAllToList(ctl As Control, lngID As Long, _
lngRow As Long, lngCol As Long, _
intCode As Integer) As Variant
Static dbs As Database, rst As Recordset
Static lngDisplayID As Long
Static intDisplayCol As Integer
Static strDisplayText As String
Dim intSemiColon As Integer
On Error GoTo Err_AddAllToList
Select Case intCode
Case acLBInitialize
' See if function is already in use.
If lngDisplayID <> 0 Then
MsgBox "AddAllToList is already in use!"
AddAllToList = False
Exit Function
End If
' Parse the display column and display text
' from the Tag property.
intDisplayCol = 1
strDisplayText = "(All)"
If Not IsNull(ctl.Tag) And (ctl.Tag <> "") Then
intSemiColon = InStr(ctl.Tag, ";")
If intSemiColon = 0 Then
intDisplayCol = Val(ctl.Tag)
Else
intDisplayCol = _
Val(Left(ctl.Tag, intSemiColon - 1))
strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
End If
End If
' Open the recordset defined in the
' RowSource property.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(ctl.RowSource, _
dbOpenSnapshot)
' Record and return the lngID for this
' function.
lngDisplayID = Timer
AddAllToList = lngDisplayID
Case acLBOpen
AddAllToList = lngDisplayID
Case acLBGetRowCount
' Return number of rows in recordset.
On Error Resume Next
rst.MoveLast
AddAllToList = rst.RecordCount + 1
Case acLBGetColumnCount
' Return number of fields (columns) in recordset.
AddAllToList = rst.Fields.Count
Case acLBGetColumnWidth
AddAllToList = -1
Case acLBGetValue
If lngRow = 0 Then
If lngCol = 0 Or lngCol = intDisplayCol Then
AddAllToList = strDisplayText
End If
Else
rst.MoveFirst
rst.Move lngRow - 1
AddAllToList = rst(lngCol)
End If
Case acLBEnd
lngDisplayID = 0
rst.Close
End Select
Bye_AddAllToList:
Exit Function
Err_AddAllToList:
MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
AddAllToList = False
Resume Bye_AddAllToList
End Function
I then change my row source type to "AddAllToList".
And then the combo box quits working.
Any suggestions would be appreciated!!!