给大家一个好东东，看你识不识货

gnoy

Private 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 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
        With cnn
          .Provider = "Microsoft.Jet.OLEDB.4.0"
          'this gets stored values from the only
          'local table to allow flexibility
          .ConnectionString = CurrentProject.Path & "\data.mdb"  'should be changed
          .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

zyz

一大堆，好难看哟，一会儿记录集，一会儿数组的。

[em26]

gnoy

看不懂就照抄，将其作为模板。這個函數可以用作組合框 /列表框的“行來源類型”

gnoy

看来这确实不是大家想要的东东。
不过我想给大家说一个情形：MDB/MDE中无任何表如何定义组合框/列表框的“行来源”？（文本框不成问题）， 不知大家有没有考虑这个问题。能实现上面情形的好处就是即使是MDB（屏蔽SHIFT）你也恐怕找不到登陆密码。可以在后端通过ADOX新建只有你知道路径的数据库及所需表（第一次安装时）然后通过ADO及上面函数将数值传递给组合框。

HG

這個難度太大，又因暫時不須，所以就沒去研究了。當然經你一提示，就知此代碼大有作用了，也收藏，隨後用時，不懂再向您請教!

gnoy

其实微软也是觉得难度大，所以才有这很怪的SELECT CASE 语句。查找组合框/列表框的“行來源類型”的自定义函数的帮助你就豁然开攘了

sdlhlsd

我有用过, 以前就发现这人好东东

gnoy

你看过的是数据第一行应该是空白，我将其完善了以下将其DO WHILE 语句改为：
For intLoopRow = 0 To sintRows - 1
svarArray(intLoopRow, 0) = rst(0)
svarArray(intLoopRow, 1) = rst(1)
' MsgBox rst(0) & rst(1)
rst.MoveNext
Next

这样去掉了第一行为空白的“缺陷”

make

好例子,学了一招,谢谢了