如何设置组合框或列表框的行来源为函数_access窗体及access控件

如何设置组合框或列表框的行来源为函数

时间：2004-05-14 13:09 来源：不详作者：不详阅读：次

如何设置组合框或列表框的行来源为函数

下列代码是一个例程，将行来源设置为这个函数：

Public Function valueList(ctl As Control, _
                          varID As Variant, _
                          lngRow As Long, _
                          lngCol As Long, _
                          intCode As Integer) As Variant
    Dim varRetVal As Variant
    Dim strField As String
     Dim strField As String
    Dim strSQL As String
    Dim strList As String
    Dim intLoopRow As Integer
    Dim intLoopCol As Integer
    Dim cnn As ADODB.Connection
    Dim RST As ADODB.Recordset
    Static svarArray() As Variant
    Static sintRows As Integer
    Static sintCols As Integer

    On Error GoTo Proc_err
    Select Case intCode
        Case acLBInitialize
            On Error Resume Next
            intLoopRow = Ubound(svarArray)
            If Err <> 0 Then
                On Error GoTo Proc_err
                'populate the customer recordset
                Set cnn = New ADODB.Connection
                cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
                cnn.Properties("Data Source") = CurrentProject.Path & "\data share\data.dat"
                cnn.Properties("Jet OLEDB:Database Password") = "123456789222"
                cnn.Open

                ' With cnn
                '.Provider = "Microsoft.Jet.OLEDB.4.0"
                'this gets stored values from the only
                'local table to allow flexibility
                '.ConnectionString = CurrentProject.Path & "\data.dat" 'should be changed
                '.Properties("Jet OLEDB:Database Password") = "123456789222"
                '.Open
                'End With
                Set RST = New ADODB.Recordset
                With RST
                    .ActiveConnection = cnn
                    .Source = "select usysuser.userid,usysuser.username from usysuser"    'should be changed
                    .CursorLocation = adUseClient
                    .CursorType = adOpenDynamic
                    .LockType = adLockReadOnly
                    .Open , , , , adCmdText
                    .MoveLast
                    sintRows = .RecordCount
                    .MoveFirst
                    sintCols = .Fields.Count
                End With    'rst
                Set cnn = Nothing
                ReDim svarArray(sintRows, sintCols)

                For intLoopRow = 0 To sintRows - 1
                    svarArray(intLoopRow, 0) = RST(0)
                    svarArray(intLoopRow, 1) = RST(1)
                    ' MsgBox rst(0) & rst(1)
                    RST.MoveNext
                Next

                RST.Close
            End If
            varRetVal = True

        Case acLBOpen    '1
            'return a unique ID code
            varRetVal = Timer

        Case acLBGetRowCount    '3
            ' Return number of rows
            varRetVal = sintRows

        Case acLBGetColumnCount    '4
            ' Return number of fields (columns)
            varRetVal = sintCols

        Case acLBGetColumnWidth    '5
            'return the column widths or
            '-1 for the default width for the column
            ' varRetVal = -1 'default width
            Select Case lngCol
                Case 0
                    'hide the first column
                    varRetVal = 0
                Case 1
                    'return the default width for column 2
                    varRetVal = -1
            End Select

        Case acLBGetValue    '6
            'Return actual data
            varRetVal = svarArray(lngRow, lngCol)
            'If lngRow = 0 Then
            'varRetVal = Null
            ' End If
        Case acLBGetFormat    '7
            'return the formatting info for the row/column
            Select Case lngCol
                Case 0

Case 1
End Select

        Case acLBEnd    '9
            'clean up
            On Error Resume Next
            Erase svarArray
            Set RST = Nothing
            Set cnn = Nothing

End Select

Proc_exit:
On Error Resume Next
valueList = varRetVal

Exit Function

Proc_err:
    'MsgBox Err.Number & "--" & Err.Description & vbCrLf & "CustomerList"
    varRetVal = False
    Resume Proc_exit
End Function

(责任编辑：admin)

顶一下

(0)

踩一下

(0)

上一篇：高手指教
下一篇：Access的小BUG--控件重绘的问题