Creation d'un fichier XML avec une macro VBA

Version imprimable

Bonjour,

Je souhaite creer un fichier XML avec une macro VBA.
Je voudrais créer un fichier XML qui a cette forme là :

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
<JDDs>
    <JDD>
         <idLME>?</idLME>
         <codeProduit>?</codeProduit>
         <typeActe>?</typeActe>
         <numContrat>?</numContrat>
         <profilInvest>?</profilInvest>
         <profilConn>?</profilConn>
         <horizonPlacement>?</horizonPlacement>
         <liquidite>?</liquidite>
         <age>?</age>
         <modeGestion>?</modeGestion>
         <repartition>
            <descriptionsRepartitions>
               <listeSupports>
                  <code>?</code>
                  <libelle>?</libelle>
                  <montant>?</montant>
                  <ouvert>?</ouvert>
               </listeSupports>
               <categorieSupports>?</categorieSupports>
            </descriptionsRepartitions>
            <typeRepartition>?</typeRepartition>
         </repartition>
   </JDD>
</JDDs>

J'ai des problème dans la macro.
Normalement chaque JDD peut avoir jusqu'à 2 blocs Repartitions.
Et chaque Bloc Repartition peut avoir plusieurs blocs Descriptions de repartition, qui peut lui même avoir plusieurs blocs Liste Support

Le problème dans le code, se situe au moment de créer le XML :
lorsque je veut afecter à la variable : "typeRepartitionElement.Text" la valeur TypeRepartition (dans mon exemple egale à "Acte") qui se trouve dans repartition1(1)

l'affeectation suivante est donc en erreur :

Code:

typeRepartitionElement.Text = Repartitions 'car incompatibiliteType

Je comprend l'erreur, parce qu'effectivement, Repartitions n'est pas une Repartition mais un tableau de Repartition1
Et je veux pour chaque repartition dans Repartitions affecter à l'element typeRepartitionElement.Text la valeur repartition1(1) qui elel aussi est amené à changer en fnction du JDD.
Mais je ne sais pas comment faire parce que je ne veux pas avoir une balises <Repartitions> qui engloberait plusieurs balise <Repartition> c'etait mon idée de depart mais ca ne correspond pas au resultat final attendu en terme de structure du XML.
Quelqu'un pourrait-il m'aider svp ?

J'ai écris le code suivant :

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
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
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 'CodeProduit dans la matrice de Reference
Dim CG_Rf             'CodeGestion dans la matrice d ereference
Dim CP_D As Long  ' CodeProduit dans la matrice de donees
Dim CG_D              'CodeGestion dans la matrice de donnees
Dim CP_F As Long  'CodeProduit dans la matrice du Fichier
Dim CG_F              'CodeGestion dans la matrice du Fichier
 
 
'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)  'on envisage avoir 36 balises JDD dans la balise JDDs
 
'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)
 
 
'----------------------------------------------structure d'un JDD particulier, 
 
Dim JDD1
ReDim JDD1(10)
 
Dim Repartition1
ReDim Repartition1(1)
 
Dim Repartition2
ReDim Repartition2(1)
 
'Declaration de sa description de repartition
Dim DescriptionRepartition1
ReDim DescriptionRepartition1(1)
 
'declaration de ses supports
Dim Support1
ReDim Support1(3)
 
 
 
'---------------------------------------Affectation des info d'un JDD----------------------------
 
j = 2      'essayons avec un seul JDD, on lit les ifo sur la deuxième ligne du fichier pour remplir les info
'For j = 2 To 2
 
 
 
    '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
            'Sinon si le Montant Min Euro est 100%
            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 If
 
 
            ReDim Preserve ListeSupports(j - 2)
            ListeSupports(j - 2) = Support1
 
            DescriptionRepartition1(0) = Support1
            DescriptionRepartition1(1) = MatriceF.Cells(k1, 12)
            ReDim Preserve DescriptionsRepartitions(j - 2)
            DescriptionsRepartitions(j - 2) = DescriptionRepartition1
 
            Repartition1(0) = DescriptionRepartition1
            ReDim Preserve Repartitions(j - 2)
            Repartitions(j - 2) = Repartition1
 
            JDD1(10) = Repartition1
 
            ReDim Preserve JDDs(j - 2)
            JDDs(j - 2) = JDD1
 
            'i = i + 1
            k1 = k1 + 1
 
            Else
                k1 = k1 + 1
            End If
 
        Wend
 
 
 
'Next
 
 
 
'--------------------------------------------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 Repartitions In JDD
            Set RepartitionsElement = xmlDoc.createElement("Repartitions")
 
            Set typeRepartitionElement = xmlDoc.createElement("typeRepartition")
            typeRepartitionElement.Text = Repartitions
            RepartitionsElement.appendChild (typeRepartitionElement)
 
            If UBound(Repartitions(0)) > -1 Then
                'Set DescriptionRepartitionsElement = xmlDoc.createElement("DescriptionRepartitions")
 
                For Each DescriptionRepartitions In Repartitions
                    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 ListeSupports In DescriptionRepartitions
                            Set ListeSupportsElement = xmlDoc.createElement("ListeSupports")
 
                            Set codeElement = xmlDoc.createElement("code")
                            codeElement.Text = ListeSupports(0)
                            ListeSupportsElement.appendChild (codeElement)
 
                            Set libelleElement = xmlDoc.createElement("libelle")
                            libelleElement.Text = ListeSupports(1)
                            ListeSupportsElement.appendChild (libelleElement)
 
                            Set montantElement = xmlDoc.createElement("montant")
                            montantElement.Text = ListeSupports(2)
                            ListeSupportsElement.appendChild (montantElement)
 
                            Set ouvertElement = xmlDoc.createElement("code")
                            codeElement.Text = ListeSupports(3)
                            ListeSupportsElement.appendChild (codeElement)
 
                            DescriptionRepartitionsElement.appendChild (ListeSupportsElement)
                        Next
 
                        RepartitionElement.appendChild (DescriptionRepartitionsElement)
                    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

01/02/2017, 10h59
Marc-L

Bonjour,

l'affectation d'un texte s'effectue soit via une chaîne entre guillemets
soit via une variable de type String ce qui n'est donc pas ton cas (variable tableau) d'où l'erreur !

Dans l'attente d'une explication claire & exhaustive de ce qui doit être affecté …

_________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
01/02/2017, 11h31
dedey63

Justement c'est ce que je dissais.
Je sais que je ne dois pas affecté le tabeau, mais la valeur Repartition1(1) = "Acte" dans mon exemple (qui est un string).
Mais au vu de mon code si je le fais comme ca, il ne prendra que la dernière valeur recu de repartition1(1) et non les valeur successive prise en fonctiond e chaque JDD.
Et c'est là mon problème.

On a normalement Repartitions qui est un tableau de Repartition1,
Chaque Repartition1 possède deux elements :
-> Un TypeRepartition
-> Une liste de DescriptionsRepartitions

Je n'arrive donc pas à contruire le XML de cette facon.

Bien cordialement.

Problème d'indentation dans le fichier XML

Bonjour,

j'ai abandonné la configuration que je voulais au depart à savoir :

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
<JDDs>
    <JDD>
         <idLME>?</idLME>
         <codeProduit>?</codeProduit>
         <typeActe>?</typeActe>
         <numContrat>?</numContrat>
         <profilInvest>?</profilInvest>
         <profilConn>?</profilConn>
         <horizonPlacement>?</horizonPlacement>
         <liquidite>?</liquidite>
         <age>?</age>
         <modeGestion>?</modeGestion>
         <repartition>
            <descriptionsRepartitions>
               <listeSupports>
                  <code>?</code>
                  <libelle>?</libelle>
                  <montant>?</montant>
                  <ouvert>?</ouvert>
               </listeSupports>
               <categorieSupports>?</categorieSupports>
            </descriptionsRepartitions>
            <typeRepartition>?</typeRepartition>
         </repartition>
    <JDD>
<JDDs>

Pour cette forme là :

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
<JDDs>
    <JDD>
         <idLME>?</idLME>
         <codeProduit>?</codeProduit>
         <typeActe>?</typeActe>
         <numContrat>?</numContrat>
         <profilInvest>?</profilInvest>
         <profilConn>?</profilConn>
         <horizonPlacement>?</horizonPlacement>
         <liquidite>?</liquidite>
         <age>?</age>
         <modeGestion>?</modeGestion>
         <Repartitions>
             <Repartition>
                  <descriptionsRepartitions>
                      <descriptionRepartitions>
                           <listeSupports>
                                 <Support>
                                      <code>?</code>
                                      <libelle>?</libelle>
                                      <montant>?</montant>
                                      <ouvert>?</ouvert>
                                 <Support> 
                          </listeSupports>
                         <categorieSupports>?</categorieSupports>
                    <descriptionRepartitions>
               </descriptionsRepartitions>
               <typeRepartition>?</typeRepartition>
            </Repartition>
         <Repartitions>
    <JDD>
<JDDs>

Par contre je constate que mon fichier XML ne ressort pas comme je veux.
Pourtant quand je controle la variable JDDs elle est conforme à l'attendu à savoir :

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
<JDD>
		<iDLME/>
		<codeProduit>91734</codeProduit>
		<typeActe/>
		<numContrat>2</numContrat>
		<profilInvest>1</profilInvest>
		<horizonPlacement>1</horizonPlacement>
		<profilConn>1</profilConn>
		<liquidite>1</liquidite>
		<age>35</age>
		<modeGestion>GP</modeGestion>
		<Repartitions>
			<Repartition>
				<typeRepartition>acte</typeRepartition>
				<DescriptionsRepartitions>
					<DescriptionRepartitions>
						<categorieSupports>Autres</categorieSupports>
						<ListeSupports>
							<Support>
								<code>MIO</code>
								<libelle>CANDI</libelle>
								<montant>0</montant>
								<ouvert>1</ouvert>
							</Support>
						</ListeSupports>
					</DescriptionRepartitions>
					<DescriptionRepartitions>
						<categorieSupports>Autres</categorieSupports>
						<ListeSupports>
							<Support>
								<code>66</code>
								<libelle>ACT</libelle>
								<montant>0</montant>
								<ouvert>1</ouvert>
							</Support>
						</ListeSupports>
					</DescriptionRepartitions>
				</DescriptionsRepartitions>
			</Repartition>
		</Repartitions>
	</JDD>
</JDDs>

Mais dans mon fichier XML les données sont plutot comme ca :

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
<JDDs>
      <JDD>
		<iDLME/>
		<codeProduit>91734</codeProduit>
		<typeActe/>
		<numContrat>2</numContrat>
		<profilInvest>1</profilInvest>
		<horizonPlacement>1</horizonPlacement>
		<profilConn>1</profilConn>
		<liquidite>1</liquidite>
		<age>35</age>
		<modeGestion>GP</modeGestion>
		<Repartitions>
			<Repartition>
				<typeRepartition>acte</typeRepartition>
				<DescriptionsRepartitions>
					<DescriptionRepartitions>
						<categorieSupports>Autres</categorieSupports>
						<ListeSupports>
							<Support>
								<code>MIO</code>
								<libelle>CANDI</libelle>
								<montant>0</montant>
								<ouvert>1</ouvert>
							</Support>
						        <Support>
								<code>66</code>
								<libelle>ACT</libelle>
								<montant>0</montant>
								<ouvert>1</ouvert>
							</Support>
						</ListeSupports>
					</DescriptionRepartitions>
				</DescriptionsRepartitions>
			</Repartition>
		</Repartitions>
	</JDD>
</JDDs>

Ce qui me fait de la perte d'informations sur les categories de supports par exemple.
Je me doute que la partie où se situe l'erreur doit donc être dans la partie construction du XML mais je ne vois pas trop vraiment où il faut corriger pouvez vous m'aider svp?

Le code finale est celui ci :

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
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
375
376
377
378
379
380
381
382
383
384
385
386
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 CptK1 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 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 3
 
 
 
    '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 '
    CptK1 = 0 'le compteur de k1 vaut 0 au depart
    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
            CptK1 = CptK1 + 1 'le compteur de k1 s'incremente, j'entre dans une description de repartition
            Support1(0) = MatriceF.Cells(k1, 8) 'Code
            Support1(1) = MatriceF.Cells(k1, 11) 'Libelle
            '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
            'Sinon si le Montant Min Euro est 100%
            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, 13) = "Autorisé" Then
                Support1(3) = 1 'Support ouvert
            Else
                  Support1(3) = 0 'Support ferme
            End If
 
 
            ReDim Preserve ListeSupports(CptK1 - 1)
            ListeSupports(CptK1 - 1) = Support1
 
            DescriptionRepartition1(0) = Support1
            DescriptionRepartition1(1) = MatriceF.Cells(k1, 12)
 
            ReDim Preserve DescriptionsRepartitions(CptK1 - 1)
            DescriptionsRepartitions(CptK1 - 1) = DescriptionRepartition1
 
 
 
            'i = i + 1
            k1 = k1 + 1
 
        Else
            k1 = k1 + 1
            CptK1 = 0 'le compteur de k1 vaut 0 au depart
        End If
 
    Wend
 
    Repartition1(0) = DescriptionsRepartitions
    ReDim Preserve Repartitions(j - 2)
    Repartitions(j - 2) = Repartition1
 
    JDD1(10) = Repartition1
 
    ReDim Preserve JDDs(j - 2)
    JDDs(j - 2) = JDD1
 
Next
 
 
 
 
 '--------------------------------------------------------------------------------------------------------------------------------------------
 
 
'--------------------------------------------Construction des JDDs
'For i = 0 To 38
 '  JDDs(i) = JDD1
'    Repartitions(0) = Repartition1
'    DescriptionsRepartitions(0) = DescriptionsRepartitions1
'    ListeSupports(0) = Support1
'Next
 
' Perosnnes = JDDs, Personne = JDD
 
 
 
'--------------------------------------------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 Support In ListeSupports
                            Set SupportElement = xmlDoc.createElement("Support")
 
                            Set codeElement = xmlDoc.createElement("code")
                            codeElement.Text = Support(0)
                            SupportElement.appendChild (codeElement)
 
                            Set libelleElement = xmlDoc.createElement("libelle")
                            libelleElement.Text = Support(1)
                            SupportElement.appendChild (libelleElement)
 
                            Set montantElement = xmlDoc.createElement("montant")
                            montantElement.Text = Support(2)
                            SupportElement.appendChild (montantElement)
 
                            Set ouvertElement = xmlDoc.createElement("ouvert")
                            ouvertElement.Text = Support(3)
                            SupportElement.appendChild (ouvertElement)
 
                            ListeSupportsElement.appendChild (SupportElement)
                        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