Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Access > VBA Access
Recharger cette page [AC-2010] ouverture de deux tables et codification d'une 3eme
S'inscrire Règles FAQ Marquer les forums comme lus
VBA Access Le forum pour les questions relatives au code VBA sous Access, et à son environnement de développement VBE.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 01/01/2012, 19h01   #1
Invité de passage
 
Homme
Inscription : janvier 2012
Messages : 1
Détails du profil
Informations personnelles :
Sexe : Homme

Informations forums :
Inscription : janvier 2012
Messages : 1
Points : 0
Points : 0
Par défaut 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 :
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
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 :
Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Private Sub Modifiable82_AfterUpdate()
DoCmd.ApplyFilter , "[annee] = Forms![frais_prospection]![Modifiable82]"
Requery
Refresh
End Sub
HP_Core_sk est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 01/01/2012, 20h01   #2
Rédacteur/Modérateur
 
Avatar de GAYOT
 
Homme Jean-Damien GAYOT
Inscription : novembre 2004
Messages : 2 076
Détails du profil
Informations personnelles :
Nom : Homme Jean-Damien GAYOT
Âge : 56
Localisation : France, Meuse (Lorraine)

Informations professionnelles :
Secteur : Distribution

Informations forums :
Inscription : novembre 2004
Messages : 2 076
Points : 4 396
Points : 4 396
Envoyer un message via Skype™ à GAYOT
Bonsoir
Pensez vous sincèrement que quelqu'un va lire une procédure aussi longue sans avoir plus de détails sur ce qui ne va pas.

Réduisez votre code et expliquez mieux votre problème.

Ps: j'ai été obligé de transformer vos champs [Code] en [Rode] car cela se confondait avec nos propres balises.
__________________
Plus j'avance et plus j'ai l'impression de ne rien savoir. Et comme j'essaie d'aller loin..!!.

Tutoriels sur:http://jdgayot.developpez.com

Pas de sujets techniques par Mp. Sinon
GAYOT est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 03h32.

Nous contacter - Developpez.com - Archives - Haut de page

 
 
Developpez.com

Nous contacter

Participez

Informations légales

 
Services

Forum Access

Blogs

Hébergement

 
Partenaires

Hébergement Web