Copier le contenu d'une table vers une autre (Combinaisons sur 4 Tables)

**vavavoum74** · 17/12/2018, 10h50

Bonjour,
Je débute encore..
Je suis en train de réaliser un planning avec des semaines "Type": A, B, C et D
j'ai donc 4 Tables: "T_PlanningPersonnel_A" ,B , C et D
Chacune contient les mêmes champs:
idPlanning qui est ne type numeroauto dans la table A , B, C et D
idPersonnel: identifie l'employé à qui se ratache le planning
puis viennent 98 champs indiquant tous les paramètres du planning

Je souhaite pouvoir copier le contenu d'une table, en selectionnant l'idPlanning , vers n'importe quelle autre. Donc copier juste une ligne du mode formulaire vers une autre table
Je souhaite pouvoir le faire "dans tous les sens" , de A vers B, C, D , en selectionnant au départ l'idPlanning et la table de la source et du destinataire.

Merci de vos avis et conseils
Je suis une quiche en VBA, peut être puis-je y arriver aussi avec des requêtes ?

**helas** · 22/12/2018, 07h55

Bonjour,
idPlanning étant un numeroAuto, il ne sera pas possible de le copier sinon le reste peut se faire avec une requête Ajout

**vavavoum74** · 22/12/2018, 08h48

Merci de ton interêt

Effectivement une requête ajout le fait, mais elle copie en ajoutant une ligne à chaque fois.

En ayant réfléchi à la chose, je pense m'orienter vers une solution du type:

si l'idPersonnel existe déja dans la table de destination alors j'utilise une mise à jour
si l'idPersonnel n'existe pas, j'utilise un ajout
: comment faire ce "si"? Existe il une fonction qui le fait?
Faut il passer par un Iif ?

en parcourant le forum, j'ai trouvé cette fonction:

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim strChp As String, i As Integer
 
 With tblfinale
    .AddNew
    For i = 0 To tblsource.Fields.Count - 1
        strChp = tblsource.Fields(i).Name
        .Fields(strChp) = tblsource(strChp)
    Next
    .Update
End With

comme j'ai 98 champs à définir, si j'ai bien compris cette fonction permet de tous les parcourir, mes tables étant identiques dans leur structure, j'espère que ça fontionnera .
peut être en commençant de i = 1 to ... comme le premier champ est un numeroauto?

**vavavoum74** · 05/01/2019, 10h37

c'est loin d'être fini, pour l'instant le code ressemble à cela:

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
Public Function CopiePlanningPersonnel(tblsource As String, tblfinale As String, idPersonnel As Long)
 
Dim strChp As String, i As Integer
 
Dim dbase As DAO.Database
Dim rset1 As DAO.Recordset
Dim rset2 As DAO.Recordset
 
Set dbase = CurrentDb
Set rset1 = dbase.OpenRecordset("select * from " & tblfinale & " where IdPersonnel= " & idPersonnel, dbOpenDynaset)
Set rset2 = dbase.OpenRecordset("select * from tblsource where (IdPersonnel= " & idPersonnel & ") order by IdPersonnel, IdPlanningPersonnel;", dbOpenSnapshot)
 
 
With tblfinale
    .AddNew
    For i = 1 To tblsource.Fields.Count - 1
        strChp = tblsource.Fields(i).Name
        .Fields(strChp) = tblsource(strChp)
    Next
    .Update
End With
 
 
MsgBox ("Copie effectuée !")
End Function

ça coince sur le with avec
Nom : Capture1.JPG
Affichages : 186
Taille : 19,5 Ko

Invité · 05/01/2019, 10h43

With rset1

a+

**tee_grandbois** · 05/01/2019, 12h09

question :
la sélection dans tblsource peut-elle contenir plusieurs enregistrements à copier ?

**vavavoum74** · 05/01/2019, 12h13

A priori c'est un idpersonnel à la fois

**tee_grandbois** · 05/01/2019, 12h29

donc order by IdPersonnel, IdPlanningPersonnel est inutile
mais cela ne change rien.
Essaie ce 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
57
Public Function CopiePlanningPersonnel(tblsource As String, tblfinale As String, idPersonnel As Long)
 
Dim strChp As String, i As Integer
Dim PkName As String
Dim strMsg As String
Dim dbase As DAO.Database
Dim rset1 As DAO.Recordset
Dim rset2 As DAO.Recordset
Dim tbldef As DAO.TableDef
Set dbase = CurrentDb
 
Set rset1 = dbase.OpenRecordset("select * from " & tblfinale & " where IdPersonnel= " & idPersonnel, dbOpenDynaset)
Set rset2 = dbase.OpenRecordset("select * from " & tblsource & " where IdPersonnel= " & idPersonnel, dbOpenSnapshot)
 
' Recherche du nom du champ de la clé primaire (si c'est un NuméroAuto)
' attention: ce code ne fonctionnera pas si la clé unique est composée de plusieurs champs
Set tbldef = dbase.TableDefs(tblsource)
For i = 0 To tbldef.Indexes.Count - 1
    If tbldef.Indexes(i).Primary And tbldef.Indexes(i).Unique Then
        PkName = tbldef.Indexes(i).Fields(0).Name
    End If
Next i
 
If Not rset2.EOF Then
    With rset1
    ' Copie ou mise à jour de la sélection
        If .EOF Then
            .AddNew
            strMsg = "Copie effectuée !"
        Else
            .Edit
            strMsg = "Mise à jour effectuée !"
        End If
' Chargement de la valeur des champs (sauf la clé unique)
        For i = 1 To tbldef.Fields.Count - 1
            If tbldef.Fields(i).Name <> PkName Then
            strChp = tbldef.Fields(i).Name
            .Fields(strChp) = rset2(strChp)
            End If
        Next
        .Update
    End With
 
    rset2.MoveNext
' affichage du message
    If rset2.EOF Then MsgBox strMsg
End If
 
' fermeture des instances ouvertes
rset1.Close
rset2.Close
Set rest1 = Nothing
Set rset2 = Nothing
Set tbldef = Nothing
Set dbase = Nothing
 
End Function

**vavavoum74** · 06/01/2019, 16h21

Merci beaucoup!

Je suis en déplacement et ne peux tester pour l'instant.

En y réfléchissant d'avantage je me rends compte que je peux avoir a copier d'un idpersonnel vers un autre mais un à la fois...

le code suivant te semble t il correct?

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
Public Function CopiePlanningPersonnel(tblsource As String, tblfinale As String, idPersonnel As Long, idPersonnelDest As Long)
 
Dim strChp As String, i As Integer
Dim PkName As String
Dim strMsg As String
Dim dbase As DAO.Database
Dim rset1 As DAO.Recordset
Dim rset2 As DAO.Recordset
Dim tbldef As DAO.TableDef
Set dbase = CurrentDb
 
Set rset1 = dbase.OpenRecordset("select * from " & tblfinale & " where IdPersonnel= " & idPersonnelDest, dbOpenDynaset)
Set rset2 = dbase.OpenRecordset("select * from " & tblsource & " where IdPersonnel= " & idPersonnel, dbOpenSnapshot)
 
' Recherche du nom du champ de la clé primaire (si c'est un NuméroAuto)
' attention: ce code ne fonctionnera pas si la clé unique est composée de plusieurs champs
Set tbldef = dbase.TableDefs(tblsource)
For i = 0 To tbldef.Indexes.Count - 1
    If tbldef.Indexes(i).Primary And tbldef.Indexes(i).Unique Then
        PkName = tbldef.Indexes(i).Fields(0).Name
    End If
Next i
 
If Not rset2.EOF Then
    With rset1
    ' Copie ou mise à jour de la sélection
        If .EOF Then
            .AddNew
            strMsg = "Copie effectuée !"
        Else
            .Edit
            strMsg = "Mise à jour effectuée !"
        End If
' Chargement de la valeur des champs (sauf la clé unique)
        For i = 1 To tbldef.Fields.Count - 1
            If tbldef.Fields(i).Name <> PkName Then
            strChp = tbldef.Fields(i).Name
            .Fields(strChp) = rset2(strChp)
            End If
        Next
        .Update
    End With
 
    rset2.MoveNext
' affichage du message
    If rset2.EOF Then MsgBox strMsg
End If
 
' fermeture des instances ouvertes
rset1.Close
rset2.Close
Set rest1 = Nothing
Set rset2 = Nothing
Set tbldef = Nothing
Set dbase = Nothing
 
End Function

Petit question complémentaire: tu dis ligne 15 que le code cherche la clé primaire numéroauto, entre les différentes tables (tblfinale et tblsource) pour un idPersonnel donné, le numeroauto ne sera je pense pas le même, cela ne risque t il pas de poser un souci?
Comment peut on avoir une clé unique composée de plusieurs champs?

J'ai hâte de tester

**tee_grandbois** · 06/01/2019, 17h16

bonjour vavavoum74,

Petit question complémentaire: tu dis ligne 15 que le code cherche la clé primaire numéroauto, entre les différentes tables (tblfinale et tblsource)

non je cherche uniquement le nom du champ contenant la clé de la table source puisque tu indiques plus haut qu'elles ont la même structure.
Pour rappel, il s'agit du champ IdPlanningPersonnel, si je me réfère à ce post

Comment peut on avoir une clé unique composée de plusieurs champs?

dans des conditions bien particulières (je pense, par exemple, à un numéro de compte bancaire: code banque, code guichet, numéro de compte), c'est possible de le faire via l'icône "Index" en création de table, mais il vaut mieux privilégier le NuméroAuto:

Nom : _pkComposée.JPG
Affichages : 192
Taille : 43,0 Ko

Nom : _pkComposée.JPG
Affichages : 192
Taille : 43,0 Ko

le code suivant te semble t il correct?

non, car il prend le IdPersonnel de la table source et le copie dans la table destination et n'utilise donc pas le IdPersonnelDest.
Je pense qu'il faut faire la substitution lors de la copie de valeur des champs:

Code :

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

1
2
3
4
5
6
7
8
9
10
        For i = 1 To tbldef.Fields.Count - 1
            If tbldef.Fields(i).Name <> PkName Then
                strChp = tbldef.Fields(i).Name
                If strChp = "IdPersonnel" Then
                    Replace(.Fields(strChp), IdPersonnel, IdPersonnelDest) = rset2(strChp)
                Else
                    .Fields(strChp) = rset2(strChp)
                End If
            End If
        Next

**vavavoum74** · 07/01/2019, 07h27

merci à toi.

voici le code en tenant compte du remplacement avec idPersonnelDest:

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
Public Function CopiePlanningPersonnel(tblsource As String, tblfinale As String, idPersonnel As Long, idPersonnelDest As Long)
 
Dim strChp As String, i As Integer
Dim PkName As String
Dim strMsg As String
Dim dbase As DAO.Database
Dim rset1 As DAO.Recordset
Dim rset2 As DAO.Recordset
Dim tbldef As DAO.TableDef
Set dbase = CurrentDb
 
Set rset1 = dbase.OpenRecordset("select * from " & tblfinale & " where IdPersonnel= " & idPersonnel, dbOpenDynaset)
Set rset2 = dbase.OpenRecordset("select * from " & tblsource & " where IdPersonnel= " & idPersonnel, dbOpenSnapshot)
 
' Recherche du nom du champ de la clé primaire (si c'est un NuméroAuto)
' attention: ce code ne fonctionnera pas si la clé unique est composée de plusieurs champs
Set tbldef = dbase.TableDefs(tblsource)
For i = 0 To tbldef.Indexes.Count - 1
    If tbldef.Indexes(i).Primary And tbldef.Indexes(i).Unique Then
        PkName = tbldef.Indexes(i).Fields(0).Name
    End If
Next i
 
If Not rset2.EOF Then
    With rset1
    ' Copie ou mise à jour de la sélection
        If .EOF Then
            .AddNew
            strMsg = "Copie effectuée !"
        Else
            .Edit
            strMsg = "Mise à jour effectuée !"
        End If
' Chargement de la valeur des champs (sauf la clé unique)
        For i = 1 To tbldef.Fields.Count - 1
            If tbldef.Fields(i).Name <> PkName Then
                strChp = tbldef.Fields(i).Name
                If strChp = "IdPersonnel" Then
                    Replace(.Fields(strChp), idPersonnel, idPersonnelDest) = rset2(strChp)
                Else
                    .Fields(strChp) = rset2(strChp)
                End If
            End If
        Next
        .Update
    End With
 
    rset2.MoveNext
' affichage du message
    If rset2.EOF Then MsgBox strMsg
End If
 
' fermeture des instances ouvertes
rset1.Close
rset2.Close
Set rest1 = Nothing
Set rset2 = Nothing
Set tbldef = Nothing
Set dbase = Nothing
 
End Function

Visiblement il y a un hic avec le remplacement , cela fait une erreur:
Nom : Capture1.JPG
Affichages : 187
Taille : 55,2 Ko

**tee_grandbois** · 07/01/2019, 11h34

bonjour,
désolé pour l'inversion (quelle buse je suis):

Code :

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

                    .Fields(strChp) = Replace(rset2(strChp), IdPersonnel, IdPersonnelDest)

par contre il faut garder la ligne 12 comme elle était avant:

Code :

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

Set rset1 = dbase.OpenRecordset("select * from " & tblfinale & " where IdPersonnel= " & idPersonnelDest, dbOpenDynaset)

**vavavoum74** · 07/01/2019, 12h02

il y avait une petite faute de frappe ligne 56, voici le code qui fonctionne parfaitement:

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
Public Function CopiePlanningPersonnel(tblsource As String, tblfinale As String, idPersonnel As Long, idPersonnelDest As Long)
 
Dim strChp As String, i As Integer
Dim PkName As String
Dim strMsg As String
Dim dbase As DAO.Database
Dim rset1 As DAO.Recordset
Dim rset2 As DAO.Recordset
Dim tbldef As DAO.TableDef
Set dbase = CurrentDb
 
Set rset1 = dbase.OpenRecordset("select * from " & tblfinale & " where IdPersonnel= " & idPersonnelDest, dbOpenDynaset)
Set rset2 = dbase.OpenRecordset("select * from " & tblsource & " where IdPersonnel= " & idPersonnel, dbOpenSnapshot)
 
' Recherche du nom du champ de la clé primaire (si c'est un NuméroAuto)
' attention: ce code ne fonctionnera pas si la clé unique est composée de plusieurs champs
Set tbldef = dbase.TableDefs(tblsource)
For i = 0 To tbldef.Indexes.Count - 1
    If tbldef.Indexes(i).Primary And tbldef.Indexes(i).Unique Then
        PkName = tbldef.Indexes(i).Fields(0).Name
    End If
Next i
 
If Not rset2.EOF Then
    With rset1
    ' Copie ou mise à jour de la sélection
        If .EOF Then
            .AddNew
            strMsg = "Copie effectuée !"
        Else
            .Edit
            strMsg = "Mise à jour effectuée !"
        End If
' Chargement de la valeur des champs (sauf la clé unique)
        For i = 1 To tbldef.Fields.Count - 1
            If tbldef.Fields(i).Name <> PkName Then
                strChp = tbldef.Fields(i).Name
                If strChp = "IdPersonnel" Then
                    .Fields(strChp) = Replace(rset2(strChp), idPersonnel, idPersonnelDest)
                Else
                    .Fields(strChp) = rset2(strChp)
                End If
            End If
        Next
        .Update
    End With
 
    rset2.MoveNext
' affichage du message
    If rset2.EOF Then MsgBox strMsg
End If
 
' fermeture des instances ouvertes
rset1.Close
rset2.Close
Set rset1 = Nothing
Set rset2 = Nothing
Set tbldef = Nothing
Set dbase = Nothing
 
End Function

En tout cas si toi tu es une buse, moi je suis soit un australopithèque, soit carrément une amibe !!

Super gros merci, je met résolu!

Copier le contenu d'une table vers une autre (Combinaisons sur 4 Tables) [AC-2016]

VBA Access

Discussions similaires

Partager

Partager