Option Explicit

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

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

Public Sub Rset_Open_R_SQL(ByVal strSQL As String)
Set rsRecset = New ADODB.Recordset
rsRecset.Open strSQL, devbase.veda2000, adOpenKeyset, adLockOptimistic
End Sub


[img=http://voffka.com/archives/studentttt.jpg]