VBA le code compile mais ne s'exécute pas

**daffy85** · 17/04/2014, 15h23

bonjour
je précise j'ai commencé a coder en vba que mardi
j'ai écris un code sur Excel. impeccable il compile bien(ce qui est souvent le cas mais ce n'est pas pour autant qui s’exécute) mais quand je lance l'exécution il plante je voudrais savoir si vous pouviez regarder ce que j'ai écrit et me dire ou se trouve mon erreur et pouvoir si possible me dire comment la corriger.

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
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
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
 
Option Explicit
 
'pour lire les caractere un a un
Function lire_caractere(chaine As String, ByRef compteur As Integer) As String
'variable
    Dim caractere As String
 
    If compteur < Len(chaine) Then
        caractere = Mid(chaine, compteur, 1)
        compteur = 1
    End If
 
End Function
 
'pour rajouter des zero a latitude et a longitude
Function format(chaine As String) As String
'variable
    Dim compteur As Integer
    Dim caractere As String
    Dim positionPoint As Integer
    Dim longueurChaine As Integer
    Dim decimalApresVirgule As Integer
    Dim nombreDecimal As Integer
    Dim nombreChiffres As Integer
    Dim i As Integer
 
    compteur = 0
    caractere = ""
    While caractere <> "."
        caractere = lire_caractere(chaine, compteur)
    Wend
 
    positionPoint = compteur
    longueurChaine = Len(chaine)
    decimalApresVirgule = nombreChiffres - nombreDecimal
    nombreDecimal = 15
 
    For i = nombreDecimal To nombreChiffres
        chaine = chaine + "0"
    Next
End Function
 
'pour enregistre la longitude et la latitude
Function enregistre_coord(latitude As String, longitude As String, souterrain As Boolean) As String
 
Dim monFichierTxt As String
Dim monFichierTxtA As String
 
latitude = format(latitude)
longitude = format(longitude)
 
Open monFichierTxt For Binary As #1
    Put #1, , "P;" & latitude & ";" & longitude & ";0;-9999;;0.000;00:00:00;0;0;-1" & Chr$(10)
Close #1
 
If souterrain = False Then
    Open monFichierTxtA For Binary As #2
        Put #2, , "P;" & latitude & ";" & longitude & ";0;-9999;;0.000;00:00:00;0;0;-1" & Chr$(10)
    Close #2
End If
 
End Function
 
'permet de lire les coordonnées d'un ou plusieurs point(longitude et lattitude).
Function lire_Coordonnees(chaine As String, ByRef compteur As Integer, coordonnees() As String, souterrain As Boolean)
'variable
    Dim caractere As String
    Dim longitude As String
    Dim latitude As String
    Dim long_val As Boolean
    Dim enregistrer_coord As String
 
 
    caractere = ""
 
    While caractere <> "("
        caractere = lire_caractere((chaine), (compteur))
    Wend
 
    longitude = ""
    latitude = ""
    long_val = True
    caractere = lire_caractere((chaine), (compteur))
 
    Do
 
     If caractere <> " " And caractere <> "," And caractere <> ")" Then
        If long_val = True Then
        longitude = longitude + caractere
        Else
        latitude = latitude + caractere
        End If
    End If
 
    If caractere = " " Then
        long_val = False
        latitude = ""
    End If
 
    If caractere = "," Then
        If coordonnees(0) = "1" Then
            enregistre_coord latitude, longitude, souterrain
        End If
        long_val = True
        longitude = ""
    End If
 
    caractere = lire_caractere(chaine, compteur)
    If caractere = ")" Then
        If coordonnees(0) = "1" Then
            enregistre_coord latitude, longitude, souterrain
        End If
    End If
 
    Loop While caractere <> ")"
 
    coordonnees(0) = longitude
    coordonnees(1) = latitude
 
End Function
 
'permet de lire le nom et les coordonnée et le status du postes de la commune .
Function noeud(insee As String, commune As String) As String
 
'variable
Dim coordonnees(1 To 2) As String
Dim souterrain As Boolean
Dim ligne As String
Dim vnoeud As String
Dim fonct As String
Dim compteur As Integer
Dim caractere As String
Dim chaine As String
Dim dipole As String
Dim longitude As String
Dim latitude As String
Dim long_noeud As Integer
Dim long_fonct As Integer
Dim ligneW As String
Dim textline As String
 
Dim dirInsee As String
Dim monFichierCsv As String
Dim monFichierTxt As String
Dim monFichierTxtA As String
 
'création des dossiers
dirInsee = "Postes\" + Mid(insee, 0, 2)
monFichierCsv = "fichier_csv\postes" & insee & ".csv"
 
On Error Resume Next
    MkDir dirInsee
    MkDir monFichierCsv
On Error GoTo 0
 
'création des fichier
monFichierTxt = dirInsee & "\" & insee & "-" & commune & "-Poste.txt"
monFichierTxtA = dirInsee & "\" & insee & "-" & commune & "-Poste2.txt"
 
On Error Resume Next
    MkDir monFichierTxt
    MkDir monFichierTxtA
On Error GoTo 0
 
Open monFichierTxt For Binary As #1
    Put #1, , "F;W;Lib\" & dirInsee & "\" & insee & Chr$(10)
Close #1
Open monFichierTxtA For Binary As #2
 
Open monFichierCsv For Input As #3
Do While Not EOF(3)
    Line Input #3, textline
 
            vnoeud = ""
            fonct = ""
            compteur = 0
            caractere = ""
            chaine = ""
            While caractere <> ";"
                caractere = lire_caractere(ligne, compteur)
                If caractere <> "\" And caractere <> ";" Then
                    vnoeud = vnoeud + caractere
                End If
            Wend
 
            caractere = lire_caractere(ligne, compteur)
            While caractere <> ";"
                caractere = lire_caractere(ligne, compteur)
                If caractere <> "\" And caractere <> ";" Then
                fonct = fonct + caractere
                End If
            Wend
            long_fonct = Len(ligne) - compteur
            chaine = Mid(ligne, compteur, long_fonct)
            compteur = 0
            coordonnees(0) = "0"
            souterrain = False
            lire_Coordonnees chaine, compteur, coordonnees, souterrain
            longitude = coordonnees(0)
            latitude = coordonnees(1)
            If fonct = "AB" Then
                ligneW = "W;" & noeud & ";" & fonct & ";" & latitude & ";" & longitude & ";0;;;0;C8;WGS84;2;1;8294;9;1;5;3;Arial Narrow,8,0,0,0,0;16711680;14745599;8;0;1;1;France;1"
                monFichierTxt = ligneW
            End If
            If fonct = "DP" Then
                ligneW = "W;" & noeud & ";" & fonct & ";" & latitude & ";" & longitude & ";0;;;0;C8;WGS84;2;1;8294;9;1;5;3;Arial Narrow,8,0,0,0,0;16711680;14745599;8;0;1;1;France;1"
                monFichierTxt = ligneW
            End If
            If fonct = "RE" Then
                ligneW = "W;" & noeud & ";" & fonct & ";" & latitude & ";" & longitude & ";0;;;0;C8;WGS84;2;1;8294;9;1;5;3;Arial Narrow,8,0,0,0,0;16711680;14745599;8;0;1;1;France;1"
                monFichierTxt = ligneW
            End If
            If fonct = "MC" Then
                ligneW = "W;" & noeud & ";" & fonct & ";" & latitude & ";" & longitude & ";0;;;0;C8;WGS84;2;1;8294;9;1;5;3;Arial Narrow,8,0,0,0,0;16711680;14745599;8;0;1;1;France;1"
                monFichierTxt = ligneW
            End If
            If fonct = "MX" Then
                ligneW = "W;" & noeud & ";" & fonct & ";" & latitude & ";" & longitude & ";0;;;0;C8;WGS84;2;1;8294;9;1;5;3;Arial Narrow,8,0,0,0,0;16711680;14745599;8;0;1;1;France;1"
                monFichierTxt = ligneW
            End If
       Loop
 Close #3
End Function
'permet de lire  le nom et le status de la ligne et ainsi que les points qui compose une commune .
Function dipole(insee As String, commune As String) As String
 
'variable
    Dim ligne As String
    Dim poste As String
    Dim vdipole As String
    Dim compteur As Integer
    Dim idrip As String
    Dim caractere As String
    Dim chaine As String
    Dim long_poste As String
    Dim long_dipole As String
    Dim coordonnees(1 To 2) As String
    Dim souterrain As Boolean
    Dim ligneT As String
    Dim textline As String
 
    Dim dirInsee As String
    Dim dirInseeA As String
    Dim monFichierCsv As String
    Dim monFichierTxt As String
    Dim monFichierTxtA As String
'création des dossiers
 
    dirInsee = "ReseauBT\" + Mid(insee, 0, 2)
    dirInseeA = "ReseauBTAerien\" + Mid(insee, 0, 2)
    monFichierCsv = "fichier_csv\postes" & insee & ".csv"
 
    On Error Resume Next
        MkDir dirInsee
        MkDir dirInseeA
        MkDir monFichierCsv
    On Error GoTo 0
 
'création des fichier
monFichierTxt = dirInsee & "\" & insee & "-" & commune & "-reseauBT.txt"
monFichierTxtA = dirInsee & "\" & insee & "-" & commune & "-reseauBTAerien.txt"
Open monFichierTxt For Binary As #1
    Put #1, , "F;T;Lib\" & dirInsee & "\" & insee & Chr$(10)
Close #1
Open monFichierTxtA For Binary As #2
    Put #2, , "F;T;Lib\" & dirInsee & "\" & insee & Chr$(10)
Close #2
 
Open monFichierCsv For Input As #3
Do While Not EOF(3)
    Line Input #3, textline
 
        poste = ""
        vdipole = ""
        idrip = ""
        compteur = 0
        caractere = ""
        chaine = ""
        While caractere <> ";"
        caractere = lire_caractere(ligne, compteur)
            If caractere <> "\" And caractere <> ";" Then
                vdipole = vdipole + caractere
            End If
        Wend
 
        If idrip = "AN-" Then
            ligneT = "T;" & idrip & poste & " " & dipole & ";1;0;8388736;65280;2;1"
            monFichierTxt = ligneT
            monFichierTxtA = ligneT
            souterrain = False
        End If
 
        If idrip = "AT-" Then
            ligneT = "T;" & idrip & poste & " " & dipole & ";1;0;65280;65280;2;1"
            monFichierTxt = ligneT
            monFichierTxtA = ligneT
            souterrain = False
        End If
 
        If idrip = "S--" Then
            ligneT = "T;" & idrip & poste & " " & dipole & ";1;0;255;65280;2;1"
            monFichierTxt = ligneT
            monFichierTxtA = ligneT
            souterrain = True
        End If
 
        long_dipole = Len(ligne) - compteur
        chaine = Mid(ligne, compteur, long_dipole)
        compteur = 0
        coordonnees(0) = "1"
        lire_Coordonnees chaine, compteur, coordonnees, souterrain
  Loop
Close #3
End Function
 
Function principale()
 
'variable
Dim ligne As String
Dim centre As String
Dim insee As String
Dim commune As String
Dim compteur As Integer
Dim caractere As String
Dim chaine As String
Dim long_centre As Integer
Dim long_insee As Integer
Dim long_commune As Integer
Dim textline As String
 
Dim repCour As String
Dim dossier As String
Dim dossier1 As String
Dim dossier2 As String
Dim fichiercommune As String
Dim communeCsv As String
Dim dirInsee As String
Dim dirInsee1 As String
Dim dirInsee2 As String
 
'recupere le repertoire courant
repCour = ThisWorkbook.Path
 
'creation de dossier
dossier = repCour & "\reseauBT"
dossier1 = dossier & "\reseauBTAerien"
dossier2 = dossier & "\Postes"
 
On Error Resume Next
    MkDir dossier
    MkDir dossier1
    MkDir dossier2
On Error GoTo 0
 
'indique le chemin ou se trouve le fichier commune
fichiercommune = repCour & "\fichier_csv\listecommune.csv"
communeCsv = fichiercommune
 
'ouvre le fichier
Open communeCsv For Input As #1
Do While Not EOF(1)
    Line Input #1, textline
 
        centre = ""
        compteur = 0
        caractere = ""
        chaine = ""
        insee = ""
        commune = ""
        While caractere <> ";"
            caractere = lire_caractere(ligne, compteur)
            If caractere <> "\" And caractere <> ";" Then
                centre = centre + caractere
            End If
        Wend
 
        caractere = lire_caractere(ligne, compteur)
 
        While caractere <> ";"
            caractere = lire_caractere(ligne, compteur)
            If caractere <> "\" And caractere <> ";" Then
            insee = insee + caractere
            End If
        Wend
 
        While caractere <> ""
            caractere = lire_caractere(ligne, compteur)
            If caractere <> "\" And caractere <> ";" Then
            commune = commune + caractere
            End If
        Wend
 
        dirInsee = "reseauBT\" & Mid(insee, 0, 2)
        dirInsee1 = "reseauBTAerien\" & Mid(insee, 0, 2)
        dirInsee2 = "Postes\" & Mid(insee, 0, 2)
        On Error Resume Next
            MkDir dirInsee
            MkDir dirInsee1
            MkDir dirInsee2
        On Error GoTo 0
 
        If insee = "85128" Then
            dipole insee, commune
            noeud insee, commune
        End If
Loop
Close #1
End Function

merci à vous

**issoram** · 17/04/2014, 15h30

Bonjour,

Tu pourrais déjà nous dire à quel endroit il plante et quel message d'erreur tu obtiens.

**daffy85** · 17/04/2014, 15h36

il arrive a créer les trois dossier a partir de la fonction principal
quand au message erreur il n’en n'y a pas.
on moment de exécution du programme il plante direct je suis obliger de fermer excel et de relancer.
Il doit faire une boucle dans le vide (je pense qu'il y a une erreur la boucle enregistre_coord)mais je suis pas sur.
j’espère avoir été assez clair

**zenpbb** · 17/04/2014, 19h04

Bonjour,

Essaie de remplacer ta fonction par la fonction Instr (consulte l'aide, ça devrait correspondre à ton besoin).

Et si tu veux vraiment utiliser ta propre fonction, remplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

caractere = Mid(chaine, compteur, 1)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lire_caractere = Mid(chaine, compteur, 1)

Car dans l'état actuel, ta fonction ne renvoie rien du tout et donc tu boucles à l'infini dans ton while...

**daffy85** · 18/04/2014, 09h25

bonjour
merci d'avoir répondu zenpbb
j'ai fais ce que as dis pour utiliser ma propre fonction le problème c'est que sa boucle toujours.
donc j'ai regarder la fonction instr mais il me mais un message erreur "argument non facultatif" mais bon je pense que je doit mal utiliser du coupe je vais réétudier cette piste.

PS: si ses pas trop demander serait-il possible d'avoir un exemple?
merci a toi issoram et désoler de ne pas avoir été très précis.

**daffy85** · 18/04/2014, 09h41

en fait j'ai réussit a faire marché la fonction instr mais sa boucle encore a l'infini donc je dois avoir un autre problème, plus qu'a le trouvé.

voila comment j'ai fait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
'pour lire les caractere un a un
Function lire_caractere(chaine As String, ByRef compteur As Integer) As String
'variable
    Dim caractere As String
 
    If compteur < Len(chaine) Then
        lire_caractere = InStr(chaine, compteur, 1)
        compteur = 1
    End If
 
End Function

si c'est mal fait dis le moi svp

VBA le code compile mais ne s'exécute pas [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager