R
ronloxton
Hi:
I am trying to populate a multicolumn combobox (Access 2000) using a
callback function (see code below). The code seems to run ok, but I do
not get any values in my combobox. This works fine if I only use a one
dimensional array.
What am I missing here? I cannot find any examples on doing this.
TIA
Ron
====== Code begins =====
Function ListFillSystems(ctl As Control, _
varId As Variant, lngRow As Variant, lngCol As Variant, _
intCode As Variant) As Variant
Dim varRetval As Variant
Dim cntr As Integer
Const cols As Integer = 2
'
' Need to do something about this
'
Static sysRecord(100, cols - 1) As Variant
On Error GoTo HandleErr
Select Case intCode
Case acLBInitialize
' Could you initialize?
Dim rs As ADODB.Recordset
Set rs = getSystems("")
While Not rs.EOF
cntr = cntr + 1
sysRecord(cntr, 0) = rs!SYSTEM_NME
sysRecord(cntr, 1) = rs!SYSTEM_NME
'Format(rs!SYSTEM_EFF_DT, "yyyy/mm/dd")
rs.MoveNext
Wend
varRetval = True
Case acLBOpen
' What's the unique identifier?
varRetval = Timer
Case acLBGetRowCount
lngRow = cntr
' How many rows are there to be?
Case acLBGetColumnCount
lngCol = cols
' How many columns are there to be?
Case acLBGetValue
'If lngRow < 10 Then
varRetval = sysRecord(lngRow, 0)
'Else
' varRetval = sysRecord(9)
' End If
' What's the value in each row/column to be?
Case acLBGetColumnWidth
varRetval = 2880
' How many twips wide should each column be?
' (optional)
Case acLBGetFormat
' What's the format for each column to be?
' (optional)
Case acLBEnd
' Just clean up, if necessary (optional, unless you use
' an array whose memory you want to release).
End Select
ExitHere:
ListFillSystems = varRetval
Exit Function
HandleErr:
Select Case Err.Number
Case 9
'Ignore subscript out of range
Resume Next
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Fill List Box Test"
End Select
Resume ExitHere
End Function
===== Code Ends ====
I am trying to populate a multicolumn combobox (Access 2000) using a
callback function (see code below). The code seems to run ok, but I do
not get any values in my combobox. This works fine if I only use a one
dimensional array.
What am I missing here? I cannot find any examples on doing this.
TIA
Ron
====== Code begins =====
Function ListFillSystems(ctl As Control, _
varId As Variant, lngRow As Variant, lngCol As Variant, _
intCode As Variant) As Variant
Dim varRetval As Variant
Dim cntr As Integer
Const cols As Integer = 2
'
' Need to do something about this
'
Static sysRecord(100, cols - 1) As Variant
On Error GoTo HandleErr
Select Case intCode
Case acLBInitialize
' Could you initialize?
Dim rs As ADODB.Recordset
Set rs = getSystems("")
While Not rs.EOF
cntr = cntr + 1
sysRecord(cntr, 0) = rs!SYSTEM_NME
sysRecord(cntr, 1) = rs!SYSTEM_NME
'Format(rs!SYSTEM_EFF_DT, "yyyy/mm/dd")
rs.MoveNext
Wend
varRetval = True
Case acLBOpen
' What's the unique identifier?
varRetval = Timer
Case acLBGetRowCount
lngRow = cntr
' How many rows are there to be?
Case acLBGetColumnCount
lngCol = cols
' How many columns are there to be?
Case acLBGetValue
'If lngRow < 10 Then
varRetval = sysRecord(lngRow, 0)
'Else
' varRetval = sysRecord(9)
' End If
' What's the value in each row/column to be?
Case acLBGetColumnWidth
varRetval = 2880
' How many twips wide should each column be?
' (optional)
Case acLBGetFormat
' What's the format for each column to be?
' (optional)
Case acLBEnd
' Just clean up, if necessary (optional, unless you use
' an array whose memory you want to release).
End Select
ExitHere:
ListFillSystems = varRetval
Exit Function
HandleErr:
Select Case Err.Number
Case 9
'Ignore subscript out of range
Resume Next
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Fill List Box Test"
End Select
Resume ExitHere
End Function
===== Code Ends ====