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
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
|
Sub DonneesConformiteDDC()
'variable du classeur où se situe les données de references
Dim ClasseurRef As Workbook
Set ClasseurRef = GetObject("\\ConformiteDDC\MatriceSolutionTotaleGP.xls") 'Classeurref est le fichier conformiteDDC
'variable du classeur où se situe les Jeux de Donnees
Dim ClasseurDonnees As Workbook
Set ClasseurDonnees = GetObject("\\ConformiteDDC\DonneesSecuritaire.xls") 'ClasseurDoonnees est le fichier
'variable du classeur où se situe les Jeux de Donnees
Dim ClasseurFacadeActe As Workbook
Set ClasseurFacadeActe = GetObject("\\ConformiteDDC\MatriceSupportsEligiblesV10.xls") 'ClasseurFacadeActe est le fichier FacadeActe
'variable du classeur où se situe les données de references
Dim DerLignR As Long
Dim DerLignD As Long
Dim DerLignF As Long
Dim montant_aleatoire As Long
Dim nbrRef As Integer
Dim nbrD As Integer
Dim nbrF As Integer
Dim i As Integer
Dim k1 As Integer
Dim k2 As Integer
Dim CP_Rf As Long 'Colonne des CodeProduit
Dim CG_Rf 'Colonne des CodeGestion
Dim CP_D As Long 'Colonne des CodeProduit
Dim CG_D 'Colonne des CodeGestion
Dim CP_F As Long 'Colonne des CodeProduit
Dim CG_F 'Colonne des CodeGestion
'Initialisation
nbrRef = 0
nbrD = 0
nbrF = 0
i = 0
montant_aleatoire = 0
'Variable ds Matrice où ce situe chaque JDD
Dim MatriceRf As Worksheet 'matrice reference preconisation
Dim MatriceD As Worksheet 'Jeux de Donnees
Dim MatriceF As Worksheet 'matrice eligibilite support
'Matrice Ref corespond à la matrie de reference des preconisations
Set MatriceRf = ClasseurRef.Sheets(1)
'Matrice Donnees corespond au JDD
Set MatriceD = ClasseurDonnees.Sheets(1)
'MatriceFacadeActe corespond au tableau d'eligibilite
Set MatriceF = ClasseurFacadeActe.Sheets(2)
'Declaration des constantes Reference
Const LigneDebRf As Integer = 5 'Ligne de debut d'affichage des donnees (hors entête)
Const ColCP_Rf As Integer = 2
'Recherche de la derniere ligne des couples dans MatriceRef
DerLignRf = MatriceRf.Cells(LigneDebRf, ColCP_Rf).End(xlDown).Row
'Declaration des constantes Donnees
Const LigneDebD As Integer = 2 'Ligne de debut d'affichage des donnees (hors entête)
Const ColCP_D As Integer = 2 'Colonne des CodeProduit
'Recherche de la derniere ligne des couples dans MatriceResultat
DerLignD = MatriceD.Cells(LigneDebD, ColCP_D).End(xlDown).Row
'Declaration des constantes FacadeActe
Const LigneDebF As Integer = 2 'Ligne de debut d'affichage des donnees (hors entête)
Const ColCP_F As Integer = 3 'Colonne des CodeProduit
'Recherche de la derniere ligne des couples dans MatriceTest
DerLignF = MatriceF.Cells(LigneDebF, ColCP_F).End(xlDown).Row
'--------------------------------------------------creation de la structure JDD
Dim JDDs
ReDim JDDs(35)
'chaque JDD a une structure répartition
Dim Repartitions
ReDim Repartitions(1)
'chaque repartition a au moins une description de répartition
Dim DescriptionsRepartitions
ReDim DescriptionsRepartitions(5)
'chaque DescriptionsRepartitions a au moins un support
Dim ListeSupports
ReDim ListeSupports(0)
'----------------------------------------------declaration du premier JDD
Dim JDD1
ReDim JDD1(10)
Dim Repartition1
ReDim Repartition1(1)
'declaration de sa repartition Initiale
Dim RepartitionIni
ReDim RepartitionIni(1)
'declaration de sa repartition Acte
Dim RepartitionActe
ReDim RepartitionActe(1)
'Declaration de sa description de repartition
Dim DescriptionRepartition1
ReDim DescriptionRepartition1(1)
'declaration de ses supports
Dim Support1
ReDim Support1(3)
'---------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------Nouvel essai creation de JDD
For j = 2 To DerLignD
'Description du JDD1
JDD1(0) = MatriceD.Cells(j, 1) 'iDLME
JDD1(1) = MatriceD.Cells(j, 2) 'codeproduit
JDD1(2) = MatriceD.Cells(j, 3) 'ADG
JDD1(3) = MatriceD.Cells(j, 4) 'NumContrat
JDD1(4) = MatriceD.Cells(j, 5) 'ProfilInvest
JDD1(5) = MatriceD.Cells(j, 6) 'ProfilConn
JDD1(6) = MatriceD.Cells(j, 7) 'HorizonPlacement
JDD1(7) = MatriceD.Cells(j, 8) 'Liquidite
JDD1(8) = MatriceD.Cells(j, 9) 'age
JDD1(9) = MatriceD.Cells(j, 10) 'modeGestion
CP_D = JDD1(1)
CG_D = JDD1(9)
If JDD1(2) = "Vsup" Then
Repartition1(1) = "initiale"
Else
Repartition1(1) = "acte"
End If
'Trouvons des supports reliés au couple (CP,CG) dans la matrice FacadeActE
i = 0
k1 = 2
montant_aleatoire = Int(200 * Rnd) + 1 'Montant aleatoire compris entre 1 et 799 999
While k1 < DerLignF
CP_F = MatriceF.Cells(k1, 3) 'CodeProduit FacadeActe
CG_F = MatriceF.Cells(k1, 5) 'CodeGestion FacadeActe
If CP_F = CP_D And CG_F = CG_D Then
Support1(0) = MatriceF.Cells(k1, 8)
Support1(1) = MatriceF.Cells(k1, 11)
'Distribution montant support
If MatriceRf.Cells(j + 3, 10) = "Neant" And MatriceRf.Cells(j + 3, 10) = "Neant" Then
If MatriceF.Cells(k1, 14) = "EURO" Then
Support1(2) = montant_aleatoire
Else
Support1(2) = montant_aleatoire / 10
End If
ElseIf MatriceRf.Cells(j + 3, 10) = 100 Then
If MatriceF.Cells(k1, 14) = "EURO" Then
Support1(2) = montant_aleatoire
Else
Support1(2) = 0
End If
End If
'Statut du support
If MatriceF.Cells(k1, 14) = "Autorisé" Then
Support1(3) = 1 'Support ouvert
Else
Support1(3) = 0 'Support ferme
End
JDD1(10) = Repartition1
ReDim Preserve ListeSupports(i)
ListeSupports(i) = Support1
DescriptionRepartition1(0) = Support1
DescriptionRepartition1(1) = MatriceF.Cells(k1, 14)
ReDim Preserve DescriptionsRepartitions(i)
DescriptionsRepartitions(i) = DescriptionRepartition1
Repartition1(0) = DescriptionRepartition1
ReDim Preserve Repartitions(i)
Repartitions(i) = Repartition1
i = i + 1
k1 = k1 + 1
End If
Else
k1 = k1 + 1
End If
Wend
JDDs(0) = JDD1
Next
'--------------------------------------PAS OBLIGER D ELIRE EN DESSOUS------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------Construction du XML
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set oCreation = xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
xmlDoc.InsertBefore oCreation, xmlDoc.ChildNodes.Item(0)
Set Root = xmlDoc.createElement("JDDs")
xmlDoc.appendChild (Root)
For Each JDD In JDDs
Set JDDElement = xmlDoc.createElement("JDD")
Set iDLMEElement = xmlDoc.createElement("iDLME")
iDLMEElement.Text = JDD(0)
JDDElement.appendChild (iDLMEElement)
Set codeProduitElement = xmlDoc.createElement("codeProduit")
codeProduitElement.Text = JDD(1)
JDDElement.appendChild (codeProduitElement)
Set typeActeElement = xmlDoc.createElement("typeActe")
typeActeElement.Text = JDD(2)
JDDElement.appendChild (typeActeElement)
Set numContratElement = xmlDoc.createElement("numContrat")
numContratElement.Text = JDD(3)
JDDElement.appendChild (numContratElement)
Set profilInvestElement = xmlDoc.createElement("profilInvest")
profilInvestElement.Text = JDD(4)
JDDElement.appendChild (profilInvestElement)
Set horizonPlacementElement = xmlDoc.createElement("horizonPlacement")
horizonPlacementElement.Text = JDD(6)
JDDElement.appendChild (horizonPlacementElement)
Set profilConnElement = xmlDoc.createElement("profilConn")
profilConnElement.Text = JDD(5)
JDDElement.appendChild (profilConnElement)
Set liquiditeElement = xmlDoc.createElement("liquidite")
liquiditeElement.Text = JDD(7)
JDDElement.appendChild (liquiditeElement)
Set ageElement = xmlDoc.createElement("age")
ageElement.Text = JDD(8)
JDDElement.appendChild (ageElement)
Set modeGestionElement = xmlDoc.createElement("modeGestion")
modeGestionElement.Text = JDD(9)
JDDElement.appendChild (modeGestionElement)
If UBound(JDD(10)) > -1 Then
Set RepartitionsElement = xmlDoc.createElement("Repartitions")
For Each Repartition In Repartitions
Set RepartitionElement = xmlDoc.createElement("Repartition")
Set typeRepartitionElement = xmlDoc.createElement("typeRepartition")
typeRepartitionElement.Text = Repartition(1)
RepartitionElement.appendChild (typeRepartitionElement)
If UBound(Repartition(0)) > -1 Then
Set DescriptionsRepartitionsElement = xmlDoc.createElement("DescriptionsRepartitions")
For Each DescriptionRepartitions In DescriptionsRepartitions
Set DescriptionRepartitionsElement = xmlDoc.createElement("DescriptionRepartitions")
Set categorieSupportsElement = xmlDoc.createElement("categorieSupports")
categorieSupportsElement.Text = DescriptionRepartitions(1)
DescriptionRepartitionsElement.appendChild (categorieSupportsElement)
'limite
If UBound(DescriptionRepartitions(0)) > -1 Then
Set ListeSupportsElement = xmlDoc.createElement("ListeSupports")
For Each ListeSupport In ListeSupports
Set ListeSupportElement = xmlDoc.createElement("ListeSupport")
Set codeElement = xmlDoc.createElement("code")
codeElement.Text = ListeSupport(0)
ListeSupportElement.appendChild (codeElement)
Set libelleElement = xmlDoc.createElement("libelle")
libelleElement.Text = ListeSupport(1)
ListeSupportElement.appendChild (libelleElement)
Set montantElement = xmlDoc.createElement("montant")
montantElement.Text = ListeSupport(2)
ListeSupportElement.appendChild (montantElement)
Set ouvertElement = xmlDoc.createElement("code")
codeElement.Text = ListeSupport(3)
ListeSupportElement.appendChild (codeElement)
ListeSupportsElement.appendChild (ListeSupportElement)
Next
DescriptionRepartitionsElement.appendChild (ListeSupportsElement)
End If
DescriptionsRepartitionsElement.appendChild (DescriptionRepartitionsElement)
Next
RepartitionElement.appendChild (DescriptionsRepartitionsElement)
End If
RepartitionsElement.appendChild (RepartitionElement)
Next
JDDElement.appendChild (RepartitionsElement)
End If
Root.appendChild (JDDElement)
Next
'Ecriture dans le fichier
Set rdr = CreateObject("MSXML2.SAXXMLReader")
Set wrt = CreateObject("MSXML2.MXXMLWriter")
Set oStream = CreateObject("ADODB.STREAM")
oStream.Open
oStream.Charset = "ISO-8859-1"
wrt.indent = True
wrt.Encoding = "ISO-8859-1"
wrt.output = oStream
Set rdr.contentHandler = wrt
Set rdr.errorHandler = wrt
rdr.Parse xmlDoc
wrt.flush
oStream.SaveToFile "JDDs.xml", 2
Set rdr = Nothing
Set wrt = Nothing
Set xmlDoc = Nothing
End Sub |
Affectations qui ne sont jamais testées dans le code
Répondre avec citation
Partager