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
| Function Valide(ByVal phrase)
Dim regEx , occurrences
Set regEx = New RegExp
regEx.Pattern = "[a-z0-9]"
regEx.IgnoreCase = True 'Ne pas distinguer les minuscules des majuscules
regEx.Global = False 'Renvoyer seulement la première occurrence
Set occurrences = regEx.Execute(phrase)
Valide = (occurrences.Count = 1)
End Function
Do While reponse <> 6
Nombre_Classe = inputBox("Entrez le nombre de classe désiré :", "Quel est le nombre de classe désiré ?")
If (Nombre_Classe <> "" AND IsNumeric(Nombre_Classe)) then
Reponse = MsgBox ("Le nombre de classe désiré est de " & Nombre_Classe & ". Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
Nom_Classe = array()
redim Nom_Classe(Nombre_Classe - 1)
For k = 0 to Nombre_Classe - 1
Reponse = 0
Do While reponse <> 6
Nom_Classe(k) = inputBox("Entrez le nom de la classe numéro " & k+1 & " :", "Quel est le nom de la classe numéro " & k+1 & " ?")
If (Nom_Classe(k) <> "") then
Reponse = MsgBox ("Le nom de votre classe est '" & Nom_Classe(k) & "'. Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
Reponse = 0
Do While reponse <> 6
Nombre_Entite = inputBox("Combien d'entité de cette classe désirez-vous créer :", "Quel est le nombre désirez d'entité de cette classe ?")
If (Nombre_Entite <> "" AND IsNumeric(Nombre_Entite)) then
Reponse = MsgBox ("Le nombre d'entité est de " & Nombre_Entite & ". Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
Entite = array()
redim Nom_Entite(Nombre_Entite - 1)
Reponse = 0
Do While reponse <> 6
Nombre_Attribut = inputBox("Entrez le nombre d'attribut de la classe :", "Quel est le nombre d'attribut de votre classe ?")
If (Nombre_Attribut <> "" AND IsNumeric(Nombre_Attribut)) then
Reponse = MsgBox ("Le nombre d'attributs est de " & Nombre_Attribut & ". Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
Nom_Attribut = array()
redim Nom_Attribut(Nombre_Attribut - 1)
Reponse = 0
For i = 0 to Nombre_Entite - 1
Do While reponse <> 6
Nom_Entite(i) = inputBox ("Entrez le nom de l'entité numéro :" & i+1 & ". Attention, ce nom ne doît pas commencer par un chiffre et n'accepte pas les caractères spéciaux." , "Quel est le nom de l'entité numéro " & i+1 & " ?")
If (Nom_Entite(i) <> "" AND Not IsNumeric(Left(Nom_Entite(i),1)) AND Valide(Nom_Entite(i))) then
Reponse = MsgBox ("Le nom de l'entité numéro " & i+1 & " est '" & Nom_Entite(i) & "'. Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
reponse = 0
Next
Reponse = 0
For i = 0 to Nombre_Attribut - 1
Do While reponse <> 6
Nom_Attribut(i) = inputBox ("Entrez le nom de l'attribut numéro " & i+1 & ". Attention, ce nom ne doît pas commencer par un chiffre, n'accepte pas les caractères spéciaux ni les espaces.","Quel est le nom de l'attribut numéro " & i+1)
If (Nom_Attribut(i) <> "" AND Not IsNumeric(Left(Nom_Attribut(i),1)) AND Valide(Nom_Attribut(i))) then
Reponse = MsgBox ("Le nom de l'attribut numéro " & i+1 & " est '" & Nom_Attribut(i) + "'. Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
reponse = 0
Next
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 Element = xmlDoc.createElement(Nom_Classe(k))
xmlDoc.appendChild(Element)
Reponse = 0
For i = 0 to (Nombre_Entite - 1)
Set NomEntite = xmlDoc.createElement(Nom_Entite(i))
For j = 0 to (Nombre_Attribut - 1)
Do While reponse <> 6
Set Valeur_attribut = xmlDoc.createElement(Nom_Attribut(j))
Valeur_attribut.Text = inputBox ("Entrez la valeur de l'attribut '"& Nom_Attribut(j) & "' de l'entité '" & Nom_Entite(i) & "'" , "Quel est la valeur de cet attribut ?")
If (Valeur_attribut.Text <> "") then
Reponse = MsgBox("La valeur de l'attribut '"& Nom_Attribut(j) & "' de l'entité '" & Nom_Entite(i) & "' est '" & Valeur_attribut.Text & "', est-ce exact ?",vbQuestion+vbYesNo, "Confirmation")
End if
Loop
NomEntite.appendChild(Valeur_attribut)
Reponse = 0
Next
Next
Element.appendChild(NomEntite)
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
Next
Do While reponse <> 6
Nom = inputBox("Entrer le nom du document XML à enregistrer :", "Quel est le nom du document XML ?")
If ( Nom <> "") then
Reponse = MsgBox("Le nom du document XML est '" & Nom & "', est-ce exact ?",vbQuestion+vbYesNo, "Confirmation")
End if
Loop
oStream.SaveToFile Nom + ".xml", 2
Set rdr = Nothing
Set wrt = Nothing
Set xmlDoc = Nothing |
