Userform Excel afficher table Access

**Rémy.A** · 21/08/2019, 22h19

Bonjour à tous,

Je viens vers vous car je ne sais comment faire...

J'ai un fichier ACCESS et un EXCEL.

Lorsque je suis dans ma feuille Excel et que je lance un Userform via un bouton, j'aimerai qu'à l'ouverture de l'USF le contenu (tous les enregistrement) de ma table Access s'affiche dans une ListBox et qu'il soit possible de sélectionner une ligne afin de pouvoir la modifier dans ACCESS.

Si quelqu'un à une idée je suis prenneur.

Voici un exemple du résultat souhaiter en image (exemple fonctionne avec Excel):

Nom : Capture.PNG
Affichages : 2727
Taille : 54,3 Ko

Nom : Capture.PNG
Affichages : 2727
Taille : 54,3 Ko

Merci d'avance pour votre aide

**Menhir** · 22/08/2019, 08h27

Des éléments de réponse ici : https://excel.developpez.com/faq/?page=Access

**Rémy.A** · 24/08/2019, 16h27

Bonjour Menhir,

Merci pour le lien.

Je n'arrive pas à afficher la table dans la liste Box..

**Philippe Tulliez** · 24/08/2019, 21h15

Bonjour,
Voici une solution basée sur une fonction que j'ai écrite il y a un certain temps et qui avait pour but d'exporter des données provenant d'une table de base de données Access

Pour l'exemple j'ai utilisé la base de données Comptoir.mdb bien connue par ceux qui utilise l'application Mso Access

Code de la fonction nommée QueryAccess utilisée pour la requête et à placer dans un module standard et qui nécessite de référencer la bibliothèque Microsoft DAO x.x ObjectLibrary

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
Function QueryAccess(dbFullName As String, _
                     sqlQuery As String, _
                     Optional WithLabel As Boolean = True, _
                     Optional LookupString As String = "*") As Variant
 ' Nécessite de référencer Microsoft DAO x.x ObjectLibrary
 ' Arguments
 '   dbFullName     ' Chemin +  nom du fichier
 '   SqlQuery       ' Chaîne de caractère contenant la requête SQL
 '   [WithLabel]    ' True ou Omis renvoie les étiquettes de colonnes
 '   [LookupString] ' Chaîne pour recherche partielle
 ' Author  : Philippe Tulliez www.magicoffice.be
 ' Version : 3.1
 ' Date    : 11/01/2014 (11/08/2013)
 
 ' Déclaration des variables
 Dim db As DAO.Database, Rs As DAO.Recordset
 Dim mytable(), count As Long, Elem As Integer
 ' Affectation
 sqlQuery = Replace(sqlQuery, "[LookupString]", Chr(34) & LookupString & "*" & Chr(34))
 Set db = Workspaces(0).OpenDatabase(dbFullName, ReadOnly:=True)
 Set Rs = db.OpenRecordset(sqlQuery)
 ' Lecture des enregistrements de la requête
 If Not Rs.EOF Then
    While Not Rs.EOF
     ReDim Preserve mytable(Rs.Fields.count, count)
     If count = 0 And WithLabel Then
       For Elem = 0 To Rs.Fields.count - 1: mytable(Elem, count) = Rs(Elem).SourceField: Next ' Label
       count = count + 1: ReDim Preserve mytable(Rs.Fields.count, count)
     End If
     For Elem = 0 To Rs.Fields.count - 1
       mytable(Elem, count) = IIf(IsNull(Rs(Elem)), "", Rs(Elem))
     Next Elem
     count = count + 1: Rs.MoveNext
    Wend
    QueryAccess = Application.WorksheetFunction.Transpose(mytable)
  Else
    QueryAccess = Array("")
 End If
 Rs.Close: db.Close: Set Rs = Nothing
End Function

Code de la procédure de démarrage nommée Main qui invoque la fonction ci-dessus et qui permet de lancer le UserForm nommé usfDemo et à placer dans un module standard

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
Sub Main()
  ' Déclaration des variables et constantes
  Const db_Name As String = "Comptoir.mdb"
  Const db_SubFolder As String = "\DataBase\"
  Dim mytable()
  Dim db_Folder As String
  '
  db_Folder = ThisWorkbook.Path
  db_FullName = db_Folder & db_SubFolder & db_Name
  mytable = QueryAccess(db_FullName, Query)
  With usfDemo
    With .lstCustomer
    .List = mytable
    .ColumnCount = 5
    .ColumnWidths = "135;75;90;50;20"
    End With
  .Show
  End With
End Sub

et en tête du même module, une variable et une constante publique.
La constante est une requête sur la table nommée Clients de la base de données Comptoir.mdb qui se trouve pour l'exemple dans un sous-répertoire nommé DataBase du répertoire où se trouve le classeur qui m'a servi d'exemple (ThisWorkbook)

Code :

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

1
2
3
Option Explicit
Public Const Query As String = "SELECT Société, Contact, Fonction, Ville, Région FROM Clients WHERE (Société Like [LookupString]) ORDER BY Société ;"
Public db_FullName As String

Code des procédures présentes dans le UserForm nommé usfDemo

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
Option Explicit
Private Sub lstCustomer_Click()
  With Me.lstCustomer
   If .ListIndex Then GetRecord .ListIndex
  End With
End Sub
 
Sub GetRecord(RecordNumber As Long)
  With Me.lstCustomer
   Me.txtCompany.Value = .List(RecordNumber, 0)
   Me.txtContact.Value = .List(RecordNumber, 1)
   Me.txtFunction.Value = .List(RecordNumber, 2)
   Me.txtCity.Value = .List(RecordNumber, 3)
  End With
End Sub
 
Private Sub TextBox1_Change()
  Dim mytable()
  mytable = QueryAccess(db_FullName, Query, LookupString:=TextBox1.Value)
  Me.lstCustomer.List = mytable
End Sub

Illustration du UserForm

Nom : 20190824 UserForm From Access.png
Affichages : 1449
Taille : 29,1 Ko

**Pierre Fauconnier** · 25/08/2019, 12h38

Salut.

Pour compléter tes possibilités de choix d'une solution à mettre en œuvre pour réaliser ce que tu souhaites obtenir, j'ai écrit 4billets sur le sujet qui développent la mise en place d'une solution d'échanges de données entre un userform (Excel, Word, PowerPoint, ...) et une base de données, ici Access:

VBA Excel - Access : Interactions entre Excel et Access avec ADODB: Fonctions génériques (1);
VBA Excel - Access : Interactions entre Excel et Access avec ADODB: Manipulation des enregistrements (2);
VBA Excel - Access : Interactions entre Excel et Access avec ADODB: Manipulations par UserForm (3);
VBA Excel - Access : Interactions entre Excel et Access avec ADODB: Manipuler vues et procédures stockées (4).

J'espère que cela te donnera des idées pour ce dimanche ensoleillé...

**Philippe Tulliez** · 25/08/2019, 12h45

Bonjour Pierre,
J'ignorais que tu avais écrit des billets sur ce sujet

Pour ton information, les deux premiers billets n'ont pas de liaisons.

**Pierre Fauconnier** · 25/08/2019, 12h47

Bonjour Philippe,

Envoyé par Philippe Tulliez

Bonjour Pierre,
J'ignorais que tu avais écrit des billets sur ce sujet

[...]

C'est normal, on est dimanche, ils sont frais du jour comme les croissants...

Envoyé par Philippe Tulliez

[...]
Pour ton information, les deux premiers billets n'ont pas de liaisons.

Corrigé, merci

**Rémy.A** · 26/08/2019, 10h45

Bonjour Messieurs,

Merci pour vos réponses.
Je fais le test dans la journée et je vous tiens informé

**Rémy.A** · 27/08/2019, 21h48

Bonjour,

Désolé de la réponse tardive.
J'ai su l'adapter et je l'ai testé. Ca fonctionne!!

Merci.

J'aurais une question.

J'ai essayé de comprendre comment la requête SQL est construite et intégré dans le code, mais je ne comprend pas tout...
Comment peut-on ajouter d'autres filtres sur la cmd SQL?

J'aimerai faire une pré-sélection sur 3 critères. Est-ce possible?
La pré-sélection avec référence fonctionne très bien car c'est le code que tu m'a mis en exemple, mais comment ajouter Fabricant et série dans la requête SQL?

Code :

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

1
2
 
"SELECT CODE,   LIBELLE,    TYPE_ID,    PRODUIT,    FABRICANT,  SERIE  FROM PLC WHERE (CODE Like [LookupString]) ORDER BY CODE ;"

User form:

Nom : CatalogMat.PNG
Affichages : 1297
Taille : 50,0 Ko

**Pierre Fauconnier** · 29/08/2019, 08h35

Salut.

Il est malaisé de te répondre sans connaître la structure de tes tables, et il serait donc intéressant que tu en donnes un aperçu. Normalement, tu as au moins trois tables (article, serie, fabricant). La structure des liaisons entre tes tables dépend du fait que la série dépend du fabricant ou pas (je suppose que c'est le cas). Mais il faut faire trop de suppositions pour pouvoir te répondre de manière pertinente.

De plus, il faudrait que tu détailles la construction de ton formulaire, car tu exposes des textbox pour le choix du fabricant, de la série et de la référence. Perso, j'aurais mis des combo à car cela me semble hasardeux d'espérer que l'utilisateur va saisir correctement le nom du fabricant et de la série. Cela permet en plus de simplifier tes requêtes.

A toi donc d'en dire plus, d'abord sur la structure de tes tables...

**Rémy.A** · 31/08/2019, 16h20

Bonjour Pierre,

Ma base de données est un fichier accdb qui est composée d'une seule table.

Dans cette table il y a 16434 enregistrement et 41 champs...
La table n'a aucune relation ni requête ni lien je m'en sert comme un simple tableau de stockage.

Nom : table plc.PNG
Affichages : 1234
Taille : 22,4 Ko

Nom : table plc.PNG
Affichages : 1234
Taille : 22,4 Ko

**Rémy.A** · 06/04/2020, 21h07

Bonjour à tous,

Je n'ai toujours pas trouvé…

Toujours pas de réponses!?

**Pierre Fauconnier** · 06/04/2020, 21h13

Plus haut dans la discussion, j'ai donné le lien de 4 billets de blog que j'ai écrit sur le sujet. Sans être trop présomptueux, j'imagine mal que tu n'y trouves pas des infos pour avancer.

Qu'as-tu essayé?
Quel code as-tu testé?
Quels résultats as-tu obtenu?
Quelles erreurs as-tu rencontrées?
As-tu utilisé les outils de débogage pour essayer de comprendre où le bât blessait?

Vu que la question initiale date de août 209, tu permettras que je te demande de répéter la question?

**Rémy.A** · 06/04/2020, 21h52

Bonjour Pierre,

Merci de m'aider :-)

Ma question est posée au poste 9.

J'ai lu les billets que tu as mis en lien, honnêtement pour le vba je n'ai pas tous compris je suis électricien et pas au courant

J'ai essayer d'ajouter des filtre sur la requête SQL mais ça n'a pas fonctionné.

Voici le code réalisé vos conseil.

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
 
Option Explicit
Public Const Query As String = "SELECT CODE,   LIBELLE,    TYPE_ID,    PRODUIT,    FABRICANT,  SERIE,  CATEGORIE,  RACK,   ALIM,   TENSION,    COURANT,    NBRE_VOIE,  NBRE_EXT,   NBRE_PAS,   NUMBER_DI,  NUMBER_DO,  NUMBER_AI,  NUMBER_AO,  NB_EMPL,    TYPE,   TECHNO, RACCORD,    NBRE_E, NBRE_S, MODULE, H_EMPL, POWER_DISSIPATION,  DX, DY, DZ, POIDS,  ACCESSOIR, OBSOLETE, SUBSTITUTION, LIBELLE_EN, CARTE, EMBASE, BORNIER FROM PLC WHERE (CODE Like [LookupString]) ORDER BY CODE ;"
Public db_FullName As String
 
Public Sub AfficherTable()
  ' D?claration des variables et constantes
  Const db_Name As String = "DATA-PLC.accdb"
  Const db_SubFolder As String = "\"
  Dim mytable()
  Dim db_Folder As String
  '
  db_Folder = ThisWorkbook.Path
  db_FullName = db_Folder & db_SubFolder & db_Name
  mytable = QueryAccess(db_FullName, Query)
  With USF_Catalog_Mat
    With USF_Catalog_Mat.List
    .List = mytable
    .ColumnCount = 38
    .ColumnWidths = "200;600;90;50;100;100;100;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;40;40;40;40;50;40;60;500;150;150;150,"
    End With
    .Label6.Caption = IList
    .Show vbModeless
    '.Show vbModal
  End With
End Sub
 
Function QueryAccess(dbFullName As String, sqlQuery As String, Optional WithLabel As Boolean = True, Optional LookupString As String = "*") As Variant  '
 
 ' Nécessite de référencer Microsoft DAO x.x ObjectLibrary
 ' Arguments
 '   dbFullName     ' Chemin +  nom du fichier
 '   SqlQuery       ' Cha?ne de caract?re contenant la requ?te SQL
 '   [WithLabel]    ' True ou Omis renvoie les ?tiquettes de colonnes
 '   [LookupString] ' Cha?ne pour recherche partielle
 ' Author  : Philippe Tulliez www.magicoffice.be
 ' Version : 3.1
 ' Date    : 11/01/2014 (11/08/2013)
 
 ' D?claration des variables
 Dim db As DAO.Database, rs As DAO.Recordset
 Dim mytable(), count As Long, Elem As Integer
 
Dim CurrentProgress As Double
Dim ProgressPercentage As Double
Dim BarWidth As Long
 
Progress.Hide
With Progress
    .Hide
    .Bar.Width = 0
    .Show vbModeless
End With
 
 ' Affectation
 sqlQuery = Replace(sqlQuery, "[LookupString]", Chr(34) & LookupString & "*" & Chr(34))
 Set db = Workspaces(0).OpenDatabase(dbFullName, ReadOnly:=True)
 Set rs = db.OpenRecordset(sqlQuery)
 
 ' Lecture des enregistrements de la requ?te
 If Not rs.EOF Then
 i = 1
    While Not rs.EOF
 
     ReDim Preserve mytable(rs.Fields.count, count)
     If count = 0 And WithLabel Then
       For Elem = 0 To rs.Fields.count - 1: mytable(Elem, count) = rs(Elem).SourceField: Next ' Label
       count = count + 1: ReDim Preserve mytable(rs.Fields.count, count)
     End If
     For Elem = 0 To rs.Fields.count - 1
       mytable(Elem, count) = IIf(IsNull(rs(Elem)), "", rs(Elem))
     Next Elem
     count = count + 1: rs.MoveNext
 
    IList = rs.RecordCount  'Variable qui est utilis? pour USF_ACESS_MODIF_Ref
    Jlist = rs.Fields.count 'Variable qui est utilis? pour USF_ACESS_MODIF_Ref
 
    CurrentProgress = i / rs.RecordCount
    BarWidth = Progress.Border.Width * CurrentProgress
    ProgressPercentage = Round(CurrentProgress * 100, 0)
 
    Progress.Bar.Width = BarWidth
    Progress.Text.Caption = "Catalogue mat?riel charg? ?:" & ProgressPercentage & "%"
    DoEvents
    i = i + 1
    Wend
 
    QueryAccess = Application.WorksheetFunction.Transpose(mytable)
 
Progress.Hide
 
 
  Else
    QueryAccess = Array("")
 End If
 rs.Close: db.Close: Set rs = Nothing
End Function

Et le code de mon USF:

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
 
Option Explicit
 
Private Sub BP_Ajouter_Click()
USF_ACCESS_AJOUT_REF.Show
End Sub
 
Private Sub BP_Supprimer_Click()
 
Dim rs As ADODB.Recordset
 
Call Ouverture_ADO
 
'Ouverture recordset / table
'Objet Recordset repr?sente les enregistrements d'une table
Set rs = New ADODB.Recordset
rs.Open "DELETE FROM [PLC]  WHERE CODE = " & Chr(34) & List.Column(0, List.ListIndex) & Chr(34), cnx
rs.Open "DELETE FROM [PLC_FDP]  WHERE CODE = " & Chr(34) & List.Column(0, List.ListIndex) & Chr(34), cnx
 
TB_Reference.Value = ""
 
'Fermeture recordset et connection
Call Fermeture_ADO
 
End Sub
 
'#############################################################################################################################
'####Gestion molette sourie###########################################################################################################
'#############################################################################################################################
 
Private Sub List_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call HookMouse(List, eSHEET)
End Sub
Private Sub List_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    UnHookMouse
End Sub
 
'#############################################################################################################################
'#############################################################################################################################
'#############################################################################################################################
 
Private Sub List_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
GetRecord
GetRecordM
End Sub
Public Sub GetRecord()
 
    TB_Reference.Value = List.Column(0, List.ListIndex)
    Ref_Access = TB_Reference.Value
End Sub
 
Public Sub GetRecordM()
With USF_ACCESS_MODIF_REF
    .M_TB_Reference.Value = List.Column(0, List.ListIndex)
    .M_TB_Libelle.Value = List.Column(1, List.ListIndex)
    .M_TB_TYPE_ID.Value = List.Column(2, List.ListIndex)
    .M_TB_PRODUIT.Value = List.Column(3, List.ListIndex)
    .M_TB_Fabricant.Value = List.Column(4, List.ListIndex)
    .M_TB_Serie.Value = List.Column(5, List.ListIndex)
    .M_TB_CATEGORIE.Value = List.Column(6, List.ListIndex)
    .M_TB_RACK.Value = List.Column(7, List.ListIndex)
    .M_TB_ALIM.Value = List.Column(8, List.ListIndex)
    .M_TB_TENSION.Value = List.Column(9, List.ListIndex)
    .M_TB_COURANT.Value = List.Column(10, List.ListIndex)
    .M_TB_NBRE_VOIE.Value = List.Column(11, List.ListIndex)
    .M_TB_NBRE_PAS.Value = List.Column(13, List.ListIndex)
    .M_TB_NUMBER_DI.Value = List.Column(14, List.ListIndex)
    .M_TB_NUMBER_DO.Value = List.Column(15, List.ListIndex)
    .M_TB_NUMBER_AI.Value = List.Column(16, List.ListIndex)
    .M_TB_NUMBER_AO.Value = List.Column(17, List.ListIndex)
    .M_TB_NB_EMPL.Value = List.Column(18, List.ListIndex)
    .M_TB_TYPE.Value = List.Column(19, List.ListIndex)
    .M_TB_TECHNO.Value = List.Column(20, List.ListIndex)
    .M_TB_RACCORD.Value = List.Column(21, List.ListIndex)
    '.M_TB_NBRE_E.Value = List.Column(22, List.ListIndex)
    '.M_TB_NBRE_S.Value = List.Column(23, List.ListIndex)
    .M_TB_MODULE.Value = List.Column(24, List.ListIndex)
    .M_TB_H_EMPL.Value = List.Column(25, List.ListIndex)
    .M_TB_POWER_DISSIPATION.Value = List.Column(26, List.ListIndex)
    .M_TB_DX.Value = List.Column(27, List.ListIndex)
    .M_TB_DY.Value = List.Column(28, List.ListIndex)
    .M_TB_DZ.Value = List.Column(29, List.ListIndex)
    .M_TB_POIDS.Value = List.Column(30, List.ListIndex)
    .M_TB_ACCESSOIR.Value = List.Column(31, List.ListIndex)
    .M_TB_OBSOLETE.Value = List.Column(32, List.ListIndex)
    .M_TB_SUBSTITUTION.Value = List.Column(33, List.ListIndex)
    .M_TB_Libelle_EN.Value = List.Column(34, List.ListIndex)
    .M_TB_REF_CARTE.Value = List.Column(35, List.ListIndex)
    .M_TB_REF_EMBASE.Value = List.Column(36, List.ListIndex)
    .M_TB_REF_BORNIER.Value = List.Column(37, List.ListIndex)
 
'
End With
End Sub
 
 
Private Sub TextBox1_AfterUpdate()
  Dim mytable()
  mytable = QueryAccess(db_FullName, Query, LookupString:=TextBox1.Value)
  With Me.List
  .List = mytable
  End With
End Sub
 
 
'#############################################################################################################################
'####Bouttons#################################################################################################################
'#############################################################################################################################
 
Private Sub BP_OK_Click()
USF_ACCESS_CREER_REF.Show
End Sub
 
Private Sub BP_Modifier_Click()
USF_ACCESS_MODIF_REF.Show
End Sub

**Pierre Fauconnier** · 06/04/2020, 21h59

Bonsoir Rémy,

Dans mon 2ième billet, j'expose comment utiliser un paramètre en créant une requête paramétrée et en utilisant le ? dans la clause WHERE, puis en passant les paramètres à la requête. On pourrait recomposer la requête sql complète par concaténation (en collant des bouts de texte l'un à l'autre), mais si ta clause comprend du texte avec certains caractères spécifiques utilisés comme caractères de contrôle ou des dates, ça pose vite des problèmes.

Pourrais-tu montrer le code que tu as testé?

**Rémy.A** · 06/04/2020, 22h45

L'idée est que :

-Par défaut, le fabricant = TOUT (TextBox3) et la série = TOUT (TextBox2) => toutes la base affichée.

-Ensuite, si l'on mets dans TexBox3 (Fabricants) la lettre "S" et que toute les références de tout les fabricant qui commence par "S" s'affichent.

-Ensuite, si l'on mets dans TexBox2 (Série) la lettre "E" et que toute les références de le série qui commence par "E" et de tout les fabricant qui commence par "S" s'affichent

-Si la TexBox2 (Série) = "E" et que TexBox3 (Fabricants) = "Tout" alors toute les références de le série qui commence par "E" s'affichent

J'ai d'abord essayer en ajoutant la série dans la condition.

Voici le code que j'ai mis dans le USF

Code :

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

1
2
3
4
5
6
7
8
9
10
 
 
Private Sub TextBox2_Change()
Dim mytable()
  mytable = QueryAccess(db_FullName, Query, LookupString:=TextBox1.Value & Chr(34) & TextBox2.Value & Chr(34))
  With Me.List
  .List = mytable
  End With
 
End Sub

Erreur:

Nom : bug.JPG
Affichages : 1097
Taille : 63,7 Ko

Pour une autre partie du code je suis arriver à faire le filtre mais avec une connexion ADO.

voici le USF
Nom : usf ado.JPG
Affichages : 1094
Taille : 42,2 Ko

Nom : usf ado.JPG
Affichages : 1094
Taille : 42,2 Ko

Code dans le USF :

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
 
Private Sub CB_Fab_Carte_Change()
RemplirListeSerie
End Sub
 
Private Sub CB_Reference_Carte_Change()
 GetValeurBD
End Sub
 
Private Sub CB_Reference_Embase_Change()
 GetValeurBD1
End Sub
 
Private Sub CB_Serie_Carte_Change()
RemplirListeModule
'RemplirListeCB_Reference_Embase
End Sub

Code dans module

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
 
Public cnx As ADODB.Connection                  'Déclaration de la variable de connexion
Public CheminAccess As String
Public ChoixTABLE As String
 
 
Public Sub Ouverture_ADO()
'Chemin de la base de donn?es
CheminAccess = ActiveWorkbook.Path & "\DATA-PLC.accdb"
'Instanciation des variables
Set cnx = New ADODB.Connection
'D?finition du pilote de connexion
cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
'D?finition de la cha?ne de connexion
cnx.ConnectionString = CheminAccess
'Ouverture de la base de donn?es
cnx.Open
End Sub
 
Public Sub Fermeture_ADO()
cnx.Close
Set cnx = Nothing
End Sub
 
 
Public Sub RemplirListeFabriquant()
 
Dim rst As ADODB.Recordset
 
Call Ouverture_ADO
 
'J'efface les anciennes valeurs du combobox
 
On Error GoTo Suite
With USF_Ajouter
    .CB_Fab_Carte.Clear
End With
 
Suite:
 
ChoixTABLE = "PLC"
'Instanciation des variables
Set rst = New ADODB.Recordset
 
' Objet Recordset repr?sente les enregistrements d'une table
rst.Open "SELECT DISTINCT FABRICANT FROM [" & ChoixTABLE & "]", cnx
Do While Not rst.EOF
 
        On Error Resume Next
        On Error GoTo Suite2
        With USF_Ajouter
        'Ajoute la valeur de la colonne Fabriquant dans le combobox
        .CB_Fab_Carte.AddItem (rst("FABRICANT"))
        End With
 
Suite2:
        'Ligne suivante
        rst.MoveNext
Loop
 
 
' Fermeture recordset et connection
rst.Close
Set rst = Nothing
 
Call Fermeture_ADO
 
End Sub
 
 
 
 
Public Sub RemplirListeSerie()
'D?claration de la variable de connexion
Dim rst As ADODB.Recordset
 
On Error GoTo Suite
With USF_Ajouter
    .CB_Serie_Carte.Clear
End With
 
Suite:
 
ChoixTABLE = "PLC"
 
Call Ouverture_ADO
'Instanciation des variables
Set rst = New ADODB.Recordset
 
' Objet Recordset repr?sente les enregistrements d'une table
On Error GoTo Suite5
rst.Open "SELECT DISTINCT SERIE FROM  [" & ChoixTABLE & "]  WHERE FABRICANT = " & Chr(34) & USF_Ajouter.CB_Fab_Carte.Value & Chr(34), cnx
Suite5:
 
Do While Not rst.EOF
 
        On Error Resume Next
 
        On Error GoTo Suite2
        With USF_Ajouter
        'Ajoute la valeur de la colonne Fabriquant dans le combobox
        .CB_Serie_Carte.AddItem (rst("SERIE"))
        End With
 
Suite2:
 
        'Ligne suivante
        rst.MoveNext
Loop
 
 
' Fermeture recordset et connection
rst.Close
Set rst = Nothing
Call Fermeture_ADO
End Sub
 
 
 
 
Public Sub RemplirListeModule()
Dim rst As ADODB.Recordset
 
On Error GoTo Suite
With USF_Ajouter
    .CB_Reference_Carte.Clear
End With
 
Suite:
 
ChoixTABLE = "PLC"
 
Call Ouverture_ADO
'Instanciation des variables
Set rst = New ADODB.Recordset
 
' Objet Recordset repr?sente les enregistrements d'une table
On Error GoTo Suite5
rst.Open "SELECT DISTINCT CODE FROM  [" & ChoixTABLE & "]  WHERE SERIE = " & Chr(34) & USF_Ajouter.CB_Serie_Carte.Value & Chr(34), cnx
Suite5:
 
Do While Not rst.EOF
 
        On Error Resume Next
 
On Error GoTo Suite2
        With USF_Ajouter
        'Ajoute la valeur de la colonne Fabriquant dans le combobox
        .CB_Reference_Carte.AddItem (rst("CODE"))
        End With
 
Suite2:
 
        '
        'Ligne suivante
        rst.MoveNext
Loop
 
' Fermeture recordset et connection
rst.Close
Set rst = Nothing
Call Fermeture_ADO
End Sub
 
 
 
 
Public Sub GetValeurBD()
 
Dim rst As ADODB.Recordset
Dim rst2 As ADODB.Recordset
 
    ChoixTABLE = "PLC"
 
Call Ouverture_ADO
    'Instanciation des variables
    Set rst = New ADODB.Recordset
    Set rst1 = New ADODB.Recordset
    Set rst2 = New ADODB.Recordset
 
    Sheets("Configue API").Select
    NomEnt = Range("M3")
 
    ' Objet Recordset repr?sente les enregistrements d'une table
    On Error GoTo Suite4
    rst.Open "SELECT DISTINCT FABRICANT, LIBELLE, SERIE, CARTE, EMBASE, BORNIER FROM [" & ChoixTABLE & "] WHERE CODE = " & Chr(34) & USF_Ajouter.CB_Reference_Carte & Chr(34), cnx, adOpenKeyset, adLockOptimistic
 
    rst2.Open "SELECT [" & NomEnt & "], [" & NomEnt & "_DX_POSITION_CARTE" & "] FROM PLC_FDP WHERE CODE = " & Chr(34) & USF_Ajouter.CB_Reference_Carte & Chr(34), cnx
 
Suite4:
    On Error Resume Next
    On Error GoTo Suite2
        With USF_Ajouter
            If USF_Ajouter.CB_Reference_Carte.Value = "" Then
                .TB_Designation_Carte.Value = ""
                Else
                'Ajoute la valeur de la colonne Fabriquant dans le combobox
                .TB_Designation_Carte.Value = rst("LIBELLE")
            End If
        End With
        ReferenceCarte = rst("CARTE")
        ReferenceEmbase = rst("EMBASE")
        ReferenceBornier = rst("BORNIER")
 
        If Not rst2(NomEnt) = "" Then
            DX_FDP = rst2(NomEnt)
        End If
        Position_Carte = rst2([" & NomEnt & "_DX_POSITION_CARTE" & "])
Suite2:
 
' Fermeture recordset et connection
rst.Close
Set rst = Nothing
rst2.Close
Set rst2 = Nothing
Call Fermeture_ADO
 
End Sub

J'ai essayer de faire la même chose, mais toujours des erreurs….

**Pierre Fauconnier** · 07/04/2020, 08h14

[EDIT]
Je ne comprends pas pourquoi tu ouvres ta db pour aller y chercher des enregistrements. Avec Excel, tu peux aller les chercher en ADODB comme je le montre dans mes billets.

Dans le like que tu montres, tu as des guillemets en trop. Ta requête devrait être, puisque tu travailles en Access ouvert et pas en Adodb, quelque chose comme like "e*". Comme tu la recomposes par concaténation, ton code devrait être du style

Code :

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

1
2
3
 
CodeValue = "e"
sql = "select... from ... where code like """ & codevalue & "*"""

[/EDIT]

**Rémy.A** · 07/04/2020, 08h36

Bonjour Pierre,

Merci, je ne savais pas pour la syntaxe..

Est-ce qu'il éviter de mettre des _ sur le non des TextBox , Label, comboBox?

Est-ce que dans la requête suivante on peut intégrer les filtre ou faut il le faire en 3 étapes comme dans le code que j'ai déjà fais?

Code :

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

1
2
3
 
 
Public Const Query As String = "SELECT CODE,   LIBELLE,    TYPE_ID,    PRODUIT,    FABRICANT,  SERIE,  CATEGORIE,  RACK,   ALIM,   TENSION,    COURANT,    NBRE_VOIE,  NBRE_EXT,   NBRE_PAS,   NUMBER_DI,  NUMBER_DO,  NUMBER_AI,  NUMBER_AO,  NB_EMPL,    TYPE,   TECHNO, RACCORD,    NBRE_E, NBRE_S, MODULE, H_EMPL, POWER_DISSIPATION,  DX, DY, DZ, POIDS,  ACCESSOIR, OBSOLETE, SUBSTITUTION, LIBELLE_EN, CARTE, EMBASE, BORNIER FROM PLC WHERE (CODE Like [LookupString]) ORDER BY CODE ;"

Pour c'est encore abstrait le Query et les modes de connexions.

**Pierre Fauconnier** · 07/04/2020, 08h41

J'étais en train d'éditer mon post pendant ta réponse, car j'ai vu que tu ouvrais ta db au lieu d'y accéder par ADODB. Dans ce cas, c'est la syntaxe Access qui prévaut, mais tu as des guillemets de trop dans ta requête. Regarde dans un premier temps ce que j'ai proposé après la modification de mon post

**Pierre Fauconnier** · 07/04/2020, 09h01

Cela dit, c'est gourmand, comme ergonomie. Est-ce que cela a du sens d'actualiser ta liste des articles lors de la saisie du fournisseur? Autrement dit, est-ce utile de rechercher les articles des fournisseurs qui commencent par s? Ca va faire mouliner ton moteur pour rien lorsque tu saisiras le nom d'un fournisseur, si la requête est relancée après chaque lettre saisie...

Userform Excel afficher table Access [XL-2019]

Macros et VBA Excel

Discussions similaires

Partager

Partager