![]() ![]() |
|
如何设置组合框或列表框的行来源为函数 | |
作者:佚名 文章来源:不详 点击数 更新时间:2008/7/28 12:15:38 文章录入:杜斌 责任编辑:杜斌 | |
|
|
下列代码是一个例程,将行来源设置为这个函数: 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 相关链接: 更多信息请访问:计算机等级考试站 计算机等级考试在线题库 计算机等级考试论坛 |
|
![]() ![]() |