Remplire listbox excel avec BDD Access

**richi2casa** · 12/03/2020, 12h30

Bonjour
vous pouvez m'aider de remplir listbox Excel .avec une buton filtrage (Recherche)
merci

**Ardus Petus** · 12/03/2020, 15h38

Bonjour,

Voici le code corrigé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Private Sub Cmd_Afficher_Click()
 Dim sqlrech As String 'sql
    Dim Recset As Recordset
    Dim gend As String
    Dim table
    Dim row As Long
    'Call Reset_Form
    Application.EnableCancelKey = xlDisabled
    Application.DisplayAlerts = 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
 
        ListBox1.Clear
        ListBox1.ColumnCount = 10
        ListBox1.ColumnWidths = "40;60;60;60;60;60;60;60;60;160"
        Recset.MoveFirst
        While Not Recset.EOF
            With ListBox1
                .AddItem Recset.Fields("Employee ID")
                row = .ListCount - 1
                .List(row, 1) = Recset.Fields("Employee Name").Value
                .List(row, 2) = Recset.Fields("Employee Prenom").Value
                .List(row, 3) = Recset.Fields("DOB").Value
                .List(row, 4) = Recset.Fields("Gender").Value
                .List(row, 5) = Recset.Fields("Qualification").Value
                .List(row, 6) = Recset.Fields("Mobile Number").Value
                .List(row, 7) = Recset.Fields("Email ID").Value
                .List(row, 8) = Recset.Fields("Address").Value
            End With
            Recset.MoveNext
        Wend
    End If
 
    Recset.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 '   MsgBox " Les Données Soumises Avec Succès ! "
    Exit Sub
 
ErrorHandler:
         'Ferme le jeu d'enregistrements s'il est toujours ouvert ...
    nConnection.Close
    MsgBox Err.Description & " " & Err.Number, vbOKOnly + vbCritical, "Database Error"
 
End Sub