bonjour
j'employe le code qui suit
Private Sub UserForm_Initialize()
' fill ListBox1 with data from a closed workbook
' can also be used from other applications to read data from an open workbook
Dim tArray As Variant
tArray = ReadDataFromWorkbook('C:\\NomDossier\\NomFichier.xls', 'NomListe')
FillListBox UserForm1.ListBox1, tArray
Erase tArray
End Sub
Private Sub FillListBox(lb As MSForms.ListBox, RecordSetArray As Variant)
' fills lb with data from RecordSetArray
Dim r As Long, C As Long
With lb
.Clear
For r = LBound(RecordSetArray, 2) To UBound(RecordSetArray, 2)
.AddItem
For C = LBound(RecordSetArray, 1) To UBound(RecordSetArray, 1)
.List(r, C) = RecordSetArray(C, r)
Next C
Next r
.ListIndex = -1 ' no item selected
End With
End Sub
Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
' requires a reference to the Microsoft ActiveX Data Objects library (menu Tools, References in the VBE)
' if SourceRange is a range reference:
' this function can only return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
' this function can return data from any worksheet in SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook('C:\\FolderName\\SourceWbName.xls', 'A1:A21')
' varRecordSetData = ReadDataFromWorkbook('C:\\FolderName\\SourceWbName.xls', 'A1:B21')
' varRecordSetData = ReadDataFromWorkbook('C:\\FolderName\\SourceWbName.xls', 'DefinedRangeName')
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
dbConnectionString = 'DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=' & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute('[' & SourceRange & ']')
On Error GoTo 0
ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
dbConnection.Close ' close the database connection
'rs.Close
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Function
InvalidInput:
MsgBox 'The source file or source range is invalid!', vbExclamation, 'Get data from closed workbook'
Set rs = Nothing
Set dbConnection = Nothing
End Function
à bientôt
