Private rsDataCombo() As clsRst
Private DataCombos() As Object ' DataCombo 'Object '
Private intDataCombos As Integer

Private Fld() As Object
Private FldType() As typeCtrl
Private FldCount As Integer
Private FldIsError() As Boolean
Private FldErrorMess() As String
Private FldSourceField() As String
Private FldRset As clsRst                                            'recordset

Public Function clsAdoRS(idx As Integer) As clsRst
Set clsAdoRS = rsDataCombo(idx)
End Function
Public Function Boundtext(idx As Integer) As Variant
DbCombo_Requery (idx)
Boundtext = DataCombos(idx).Boundtext
End Function
Public Sub BoundText_set(idx As Integer, myVal As Variant)
 DataCombos(idx).Boundtext = myVal
End Sub

Public Function MatchedWithList(idx As Integer) As Variant
MatchedWithList = DataCombos(idx).MatchedWithList
End Function

Public Function DbCombo_Load(ByVal idx As Integer, _
                             ByVal strId_field As String, _
                             ByVal strTableSource As String, _
                             ByVal strOrderByField As String, _
                             ByRef dcbo As Object, _
                             Optional ByVal idvalue, _
                             Optional strSQL As String) As Integer
intDataCombos = IIf(idx =  0 , intDataCombos +  1 , idx)
ReDim Preserve rsDataCombo(intDataCombos)
ReDim Preserve DataCombos(intDataCombos)

'Set DataCombos(intDataCombos) = dcbo
Set DataCombos(intDataCombos) = dcbo

Set rsDataCombo(intDataCombos) = New clsRst
    
rsDataCombo(intDataCombos).s_strID_Field = strId_field
If Not ((strSQL = "")) Then
    Call rsDataCombo(intDataCombos).Rset_Open_R_SQL(strSQL)
Else
    rsDataCombo(intDataCombos).s_strSqlSource = strTableSource
    Call rsDataCombo(intDataCombos).Rset_Open_R(, strOrderByField)
End If
Set dcbo.RowSource = rsDataCombo(intDataCombos).rsRecset
dcbo.ListField = strOrderByField
dcbo.BoundColumn = strId_field
If ((Not (IsMissing(idvalue))) And (Not (IsNull(idvalue)))) Then
     dcbo.Boundtext = (idvalue)
End If
DbCombo_Load = intDataCombos
'dcbo.BoundText = idvalue
End Function


Public Sub DbCombo_Requery(intI As Integer)

rsDataCombo(intI).rsRecset.Requery
End Sub

Public Sub DbCombo_Close()

Dim i As Integer
For i =  1  To intDataCombos
'    rsDataCombo(intDataCombos).Table_Close
    Set rsDataCombo(intDataCombos) = Nothing
Next
End Sub

Private Sub Class_Initialize()
  intDataCombos =  0 
End Sub


Private Sub Class_Terminate()
  DbCombo_Close
End Sub

Option Explicit

Dim Combos() As ComboBox
Dim Combos_id() As Variant
Dim intCombos As Integer
Public clsAdo As clsRst

Public Function Cbo_ListIndex(idx As Integer)
Cbo_ListIndex = Combos_id(idx, Combos(idx).ListIndex)
End Function
Public Function Combo_Load(ByVal idx As Integer, _
                            ByVal strId_field As String, _
                            ByVal strTableSource As String, _
                            ByVal strOrderByField As String, _
                            ByRef dcbo As ComboBox, _
                   Optional ByVal idvalue, _
                   Optional ByVal strSQL As String, _
                   Optional ByVal isAll As Boolean = False) As Integer

intCombos = IIf(idx =  0 , intCombos +  1 , idx)
ReDim Preserve Combos(intCombos +  1 )
'ReDim Preserve Combos_id(intCombos + 1)
Set Combos(intCombos) = dcbo


Set clsAdo = New clsRst
clsAdo.s_strID_Field = strId_field

If (IsMissing(strSQL)) Then
    Call clsAdo.Rset_Open_R_SQL(strSQL)
Else
    clsAdo.s_strSqlSource = strTableSource
    Call clsAdo.Rset_Open_R(, strOrderByField)
End If
Dim intRecords As Integer
Dim intI As Integer
intRecords = clsAdo.rsRecset.RecordCount
If intRecords > 0 Then
    ReDim Preserve Combos_id(intCombos + 1, intRecords)
    clsAdo.rsRecset.MoveFirst
    dcbo.AddItem "Âñå", 0
    Combos_id(intCombos, 0) = 0
    For intI = 1 To intRecords
        dcbo.AddItem clsAdo.rsRecset.Fields(strOrderByField), intI
        Combos_id(intCombos, intI) = clsAdo.rsRecset.Fields(strId_field)
        clsAdo.rsRecset.MoveNext
    Next
End If

'If ((Not (IsMissing(idvalue))) And (Not (IsNull(idvalue)))) Then
'     dcbo.Boundtext = (idvalue)
'End If
'DbCombo_Load = intCombos
End Function

Private Sub Class_Terminate()
Set clsAdo = Nothing

End Sub