[AC-2010] ouverture de deux tables et codification d'une 3eme

Bonjour,

Bonne et Heureuse Année.

Je vous fais part de mon problème.

J'ai une BD Access 2010 : dont voici un exemple et le code.

Je suis preneur de toute simplification et amélioration.

D'avance merci beaucoup et à tous.

Phil

Table 1 : DATE; LIBELLE; CENTRE; PIECE; CHAMP_1; ......; CHAMP11; VALIDE; TYPE
Exemple :
01/01/2010; LIBELLE_1; CENTRE_1; PIECE_1; CHAMP_1; .....; CHAMP_11; VRAI; INTERNE
01/01/2010; LIBELLE_1; CENTRE_1; PIECE_1; CHAMP_1; .....; CHAMP_11; VRAI; EXTERNE
01/01/2010; LIBELLE_1; CENTRE_1; PIECE_1; CHAMP_1; .....; CHAMP_11; FAUX; INTERNE

Table 2 : TYPE; NUM_LIGNE; JOURNAL; COMPTE; SENS
Exemple :
INTERNE; 1; JOURNAL; COMPTE; DEBIT
INTERNE; 2; JOURNAL; COMPTE; DEBIT
INTERNE; 3; JOURNAL; COMPTE; DEBIT
INTERNE; 4; JOURNAL; COMPTE; CREDIT
EXTERNE; 1; JOURNAL; COMPTE; DEBIT
EXTERNE; 2; JOURNAL; COMPTE; CREDIT

RESULTAT DE L'EXPORT POUR LA LIGNE 1 DE LA TABLE 1 VERS UNE NOUVELLE TABLE :
1; JOURNAL; DATE; lIBELLE; MONTANT_DEBIT; 0 ; CENTRE; PIECE
2; JOURNAL; DATE; lIBELLE; MONTANT_DEBIT; 0 ;CENTRE; PIECE
3; JOURNAL; DATE; lIBELLE; MONTANT_DEBIT; 0 ;CENTRE; PIECE
4; JOURNAL; DATE; lIBELLE; 0; MONTANT_CREDIT; CENTRE; PIECE

Code:

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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
Private Sub insertion_Click()
'Variable diverses
Dim RS, RS2 As Recordset
Dim DB As Database
Dim I, J, K As Integer
Dim N As Integer
Dim Periode As Integer
Dim Champ_1, Champ_2, Champ_3, Champ_4, Champ_5, Champ_6, Champ_7, Champ_8, Champ_9, Champ_10, Champ_11 As Double
Dim SDATE, SLIBELLE, SCENTRE, SPIECE As String
 
Set DB = Application.CurrentDb
Set RS = DB.OpenRecordset("frais_prospection")
RS.MoveFirst
RS.MoveLast
 
'1er problème je ne veux que le nombre d'enregistrement d'une année
'pour information je filtre le formulaire avant de lancer la procédure
MsgBox "Nombre d'Enregistrement : " & RS.RecordCount
N = RS.RecordCount
 
'Insertion des valeurs
    Set RS2 = DB.OpenRecordset("Detail_Type_Ecriture")
    RS2.MoveLast
    RS2.MoveFirst
'Boucle sur le nombre d'enregistrement
For I = 1 To N
SDATE = RS.Fields(2).Value
SLIBELLE = Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value
SCENTRE = RS.Fields(9).Value
SPIECE = RS.Fields(0).Value & "-" & RS.Fields(1).Value
    'If RS.Fields(0).Value = PERIODE Then
 
    'Champ 1
    If RS.Fields(14).Value <> Null Or RS.Fields(14).Value <> 0 Then
    Champ_1 = RS.Fields(14).Value
    Else
    Champ_1 = 0
    End If
 
    'Champ 2
    If RS.Fields(15).Value <> Null Or RS.Fields(15).Value <> 0 Then
    Champ_2 = RS.Fields(15).Value
    Else
    Champ_2 = 0
    End If
 'Champ 3
    If RS.Fields(16).Value <> Null Or RS.Fields(16).Value <> 0 Then
    Champ_3 = RS.Fields(16).Value
    Else
    Champ_3 = 0
    End If
 
    'Champ 4
    If RS.Fields(17).Value <> Null Or RS.Fields(17).Value <> 0 Then
    Champ_4 = RS.Fields(17).Value
    Else
    Champ_4 = 0
    End If
 
    'Champ 5
    If RS.Fields(18).Value <> Null Or RS.Fields(18).Value <> 0 Then
    Champ_5 = RS.Fields(18).Value
    Else
    Champ_5 = 0
    End If
 
    'Champ 6
    If RS.Fields(19).Value <> Null Or RS.Fields(19).Value <> 0 Then
    Champ_6 = RS.Fields(19).Value
    Else
    Champ_6 = 0
    End If
 
    'Champ 7
    If RS.Fields(20).Value <> Null Or RS.Fields(20).Value <> 0 Then
    Champ_7 = RS.Fields(20).Value
    Else
    Champ_7 = 0
    End If
 
    'Champ 8
    If RS.Fields(21).Value <> Null Or RS.Fields(21).Value <> 0 Then
    Champ_8 = RS.Fields(21).Value
    Else
    Champ_8 = 0
    End If
 
    'Champ 10
    If RS.Fields(23).Value <> Null Or RS.Fields(23).Value <> 0 Then
    Champ_10 = RS.Fields(23).Value
    Else
    Champ_10 = 0
    End If
 
    'Champ 11
    If RS.Fields(22).Value <> Null Or RS.Fields(22).Value <> 0 Then
    Champ_11 = RS.Fields(22).Value
    Else
    Champ_11 = 0
    End If
 
    'Champ 9
    Champ_9 = Champ_11 - Champ_10
  'Insertion
    If RS.Fields(25).Value = "Vrai" Then
    'Aperçu des valeurs
    MsgBox "Numéro du champ : " & I & vbLf & _
    " Date         : " & SDATE & vbLf & _
    " Libelle      : " & SLIBELLE & vbLf & _
    " Centre       : " & SCENTRE & vbLf & _
    " Piece        : " & SPIECE & vbLf & _
    " Champ 1           : " & Champ_1 & vbLf & _
    " Champ 2    : " & Champ_2 & vbLf & _
    " Champ 3    : " & Champ_3 & vbLf & _
    " Champ 4        : " & Champ_4 & vbLf & _
    " Champ 5            : " & Champ_5 & vbLf & _
    " Champ 6   : " & Champ_6 & vbLf & _
    " Champ 7    : " & Champ_7 & vbLf & _
    " Champ 8           : " & Champ_8 & vbLf & _
    " Champ 9     : " & Champ_9 & vbLf & _
    " Champ 10 : " & Champ_10 & vbLf & _
    " Champ 11      : " & Champ_11 & vbLf & _
    " Validé ?      : " & RS.Fields(25).Value, vbInformation, "Message d'Information"
 
On Error Resume Next
    For K = 1 To 15
 
 'Champ_K =1
    If K = 1 And Champ_1 <> 0 Then
    MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & SDATE & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & SLIBELLE & vbLf & _
    " Débit                     : " & Champ_1 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & SPIECE & vbLf & _
    " Centre Analytique         : " & SCENTRE
    DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_1 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =2
     ElseIf K = 2 And Champ_2 <> 0 Then
    MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & SDATE & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & SLIBELLE & vbLf & _
    " Débit                     : " & Champ_2 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & SPIECE & vbLf & _
    " Centre Analytique         : " & SCENTRE
    DoCmd.RunSQL "INSERT INTO Preparation_Export  ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_2 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =3
     ElseIf K = 3 And Champ_3 <> 0 Then
     MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & RS.Fields(2).Value & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value & vbLf & _
    " Débit                     : " & Champ_3 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & RS.Fields(0).Value & "-" & RS.Fields(1).Value & vbLf & _
    " Centre Analytique         : " & RS.Fields(9).Value
    DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_3 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =4
     ElseIf K = 4 And Champ_4 <> 0 Then
     MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & RS.Fields(2).Value & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value & vbLf & _
    " Débit                     : " & Champ_4 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & RS.Fields(0).Value & "-" & RS.Fields(1).Value & vbLf & _
    " Centre Analytique         : " & RS.Fields(9).Value
    DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_4 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =5
     ElseIf K = 5 And Champ_5 <> 0 Then
     MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & RS.Fields(2).Value & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value & vbLf & _
    " Débit                     : " & Champ_5 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & RS.Fields(0).Value & "-" & RS.Fields(1).Value & vbLf & _
    " Centre Analytique         : " & RS.Fields(9).Value
    DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_5 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =6
     ElseIf K = 6 And Champ_6 <> 0 Then
     MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & RS.Fields(2).Value & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value & vbLf & _
    " Débit                     : " & Champ_6 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & RS.Fields(0).Value & "-" & RS.Fields(1).Value & vbLf & _
    " Centre Analytique         : " & RS.Fields(9).Value
 DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_6 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =7
     ElseIf K = 7 And Champ_7 <> 0 Then
     MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & RS.Fields(2).Value & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value & vbLf & _
    " Débit                     : " & Champ_7 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & RS.Fields(0).Value & "-" & RS.Fields(1).Value & vbLf & _
    " Centre Analytique         : " & RS.Fields(9).Value
 DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_7 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    'Champ_K =8
     ElseIf K = 8 And Champ_8 <> 0 Then
     MsgBox "Numéro du champ : " & K & vbLf & _
    " Journal                   : " & RS2.Fields(1).Value & vbLf & _
    " Date                      : " & RS.Fields(2).Value & vbLf & _
    " Compte                    : " & RS2.Fields(4).Value & vbLf & _
    " Libelle                   : " & Left(RS.Fields(5).Value, 3) & "-" & RS.Fields(6).Value & vbLf & _
    " Débit                     : " & Champ_8 & vbLf & _
    " Crédit                    : " & 0 & vbLf & _
    " Pièce                     : " & RS.Fields(0).Value & "-" & RS.Fields(1).Value & vbLf & _
    " Centre Analytique         : " & RS.Fields(9).Value
 DoCmd.RunSQL "INSERT INTO Preparation_Export ([Rode],[Numero],[Libelle_PEP],[Debit],[Credit],[NumeroPiece],[CentreSimple])" & vbLf & _
    " VALUES ('" & RS2.Fields(1).Value & "' , '" & RS2.Fields(4).Value & "', '" & SLIBELLE & "', '" & Champ_8 & "', 0, '" & SPIECE & "', '" & SCENTRE & "')"
 
    End If
 
    Next K
 
    'Message pas de valeurs
    ElseIf RS.Fields(25).Value = "Faux" Then
    'MsgBox "Pas de valeurs à insérer", vbExclamation, "Message"
    End If
 
    RS.MoveNext
    RS2.MoveNext
 
Next I
 
RS.Close
DB.Close
 
Set RS = Nothing
Set DB = Nothing
 
End Sub

Code:

1
2
3
4
5
Private Sub Modifiable82_AfterUpdate()
DoCmd.ApplyFilter , "[annee] = Forms![frais_prospection]![Modifiable82]"
Requery
Refresh
End Sub