Bonjour,

Je voudrais à partir de ma tbl adhérents et tbl Adhérents import (avec un champ activités concaténé) créer une 3ème tbl activités qui comprend une ligne par activité.

Le code ci-joint me donne un résultat correct si je vide la table activités à chaque Màj.
Mais vider la table me pose un problème car je crée d’autres activités manuellement.

Il faudrait que je puisse ajouter et faire des Màj des enregistrements.

Je joins ci-après le code.

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
Sub MajActivite()
 
'--- Ouverture de la base
     Set db = CurrentDb
 
'--- Intérogation de la tbl adhérents rs
     rq = "SELECT * From [tbl Adhérents]"
     Set rs = db.OpenRecordset(rq, dbOpenDynaset)
 
'--- Intérogation de la tbl adhérents Import rs1
     rq = "SELECT * From [tbl Adhérents Import]"
     Set rs1 = db.OpenRecordset(rq, dbOpenDynaset)
 
'--- Intérogation de la tbl Activité rs3
     rq = "select * From [tbl Activités]"
     Set rs3 = db.OpenRecordset(rq, dbOpenDynaset)
 
'--- Test sur EOF
     If rs.EOF Then blnCibleVide = True Else blnCibleVide = False
 
'--- Boucle sur la table rs et rs1
     Do While Not rs1.EOF      
     Do While Not rs.EOF 
 
'--- Rechercher si le numéro  existe
      If blnCibleVide Then 
         blnExistePas = True
      Else
          rs3.FindFirst "[RéfAdhérent]=" & (rs![RéfAdhérent]) & ""
         blnExistePas = rs3.NoMatch 
      End If
 
      TabVar = Split((rs1("Activites")), ",")
 
      For intI = 0 To UBound(TabVar)
 
      If blnExistePas Then 
         rs3.AddNew
         rs3("Discipline") = Trim(TabVar(intI))
         rs3("RéfAdhérent") = rs("RéfAdhérent")
         rs3.Update
      Else
 '--- Existe on met à jours
         rs3.Edit
         rs3("Discipline") = TabVar(intI)
         rs3("RéfAdhérent") = rs("RéfAdhérent")
         rs3.Update
      End If
     Next
     rs1.MoveNext
     rs.MoveNext
Loop
Loop
     Set rs = Nothing
     Set rs1 = Nothing
End Sub
Merci pour votre aide.

Salutations