Dim Liste()
Private Sub UserForm_Initialize()
'Microsoft ActiveX DataObject doit être coché
' Champ nommé BD
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
ThisWorkbook.Path & "\" & "BDPROD.xls"
Set rs = cnn.Execute("SELECT count(*) as nb FROM [TABLE$A1:D1000] where libellé<>''")
ReDim Liste(0 To rs("nb"), 1 To 4)
'Set rs = cnn.Execute("SELECT libellé,Codification,Prix,Unité FROM BD where libellé<>''")
'Set rs = cnn.Execute("SELECT libellé,Codification,Prix,Unité FROM [TABLE$A1:D1000] where libellé<>''")
Set rs = cnn.Execute("SELECT * FROM [TABLE$A1:D1000] where libellé='" & Me.ListBox1 & "'")
[j2].CopyFromRecordset rs
Me.ListBox1.Clear
i = 0
Do While Not rs.EOF
On Error Resume Next ' cellules vides
Liste(i, 1) = rs("libellé")
Liste(i, 2) = rs("codification")
Liste(i, 3) = rs("Prix")
Liste(i, 4) = rs("Unité")
On Error GoTo 0
i = i + 1
rs.MoveNext
Loop
Me.ListBox1.List = Liste
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Liste = Me.ListBox1.List
End Sub
Private Sub TextBox1_Change()
Me.ListBox1.Clear
j = 0
For i = LBound(Liste) To UBound(Liste)
If UCase(Liste(i, 0)) Like "*" & UCase(Me.TextBox1) & "*" _
Or "*" & UCase(Liste(i, 1)) Like "*" & UCase(Me.TextBox1) & "*" Then
On Error Resume Next
Me.ListBox1.AddItem Liste(i, 0)
Me.ListBox1.List(j, 1) = Liste(i, 1)
Me.ListBox1.List(j, 2) = Liste(i, 2)
Me.ListBox1.List(j, 3) = Liste(i, 3)
On Error GoTo 0
j = j + 1
End If
Next i
End Sub
Private Sub ListBox1_Click()
ActiveCell = Me.ListBox1
ActiveCell.Offset(, 1) = Me.ListBox1.Column(1)
ActiveCell.Offset(, 2) = CDbl(Me.ListBox1.Column(2))
ActiveCell.Offset(, 3) = Me.ListBox1.Column(3)
Unload Me
End Sub