Recherche dans listbox en excel avec BDD Access

richi2casa

New Member
Joined
Feb 9, 2020
Messages
1
Office Version
2019, 2016, 2010, 2007
Platform
Windows
bonjour
vous pouvez m'aider pour trouver une solution car
j'ai bloque de faire une liaison avec listbox en excel et base donne Access pour la commande recherche ou filtre
merci

VBA Code:
       Private Sub Cmd_Afficher_Click()
Dim sqlrech As String 'sql
Dim Recset As Recordset
Dim gend As String
Dim table
'Call Reset_Form
Application.EnableCancelKey = xlDisabled
Application.DisplayAlerts = False
Application.ScreenUpdating = False

sqlrech = "Select * from tblEmployee where [Employee Name]  like  '%" & txtEmpID.Text & "%'"
'sqlrech = "SELECT * FROM tblEmployee WHERE [Employee Name]  Like '" & Me.txtEmpID.Text & " *' ORDER BY [Employee Prenom]"
Set Recset = New ADODB.Recordset

Recset.Open Source:=sqlrech, ActiveConnection:=nConnection, CursorType:=adOpenKeyset, LockType:=adLockOptimistic

' On s'assure qu'il y a des enregistrements à récupérer ...

If Recset.EOF Then
MsgBox "Aucun enregistrement !", vbExclamation
Else
With Recset
Usf_search.ListBox1.Clear
Usf_search.ListBox1.ColumnCount = 10
Usf_search.ListBox1.ColumnWidths = "40;60;60;60;60;60;60;60;60;160"
Usf_search.ListBox1.AddItem
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Recset.Fields("Employee ID").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Recset.Fields("Employee Name").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = .Fields("Employee Prenom").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Recset.Fields("DOB").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Recset.Fields("Gender").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Recset.Fields("Qualification").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Recset.Fields("Mobile Number").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = Recset.Fields("Email ID").Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = Recset.Fields("Address").Value
End With

End If

Recset.Close
Set Recset = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True
'   MsgBox " Les Données Soumises Avec Succès ! "
Exit Sub

ErrorHandler:

MsgBox Err.Description & " " & Err.Number, vbOKOnly + vbCritical, "Database Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True

'Ferme le jeu d'enregistrements s'il est toujours ouvert ...
nConnection.Close


End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Forum statistics

Threads
1,089,218
Messages
5,406,923
Members
403,113
Latest member
ms_excel_recal_or_die

This Week's Hot Topics

Top