Problème cartographie France

**nguyenthithuan** · 23/07/2014, 17h09

Bonjour tout le monde,

ça commence à faire un moment que je m'arrache les cheveux sur un trucs tout simple je pense et je ne trouve pas la réponse...il s'agit tout simplement d'ajouter un département à une carte...autant vous dire que j'ai juste récupérer le code et je l'ai appliqué à mon fichier sauf qu'évidemment mon nouveau département bug...
Sur le code ci-dessous, je m'aperçois que "If Ismissing(Shape) etc"...n'existe pas sur le VBA, du coup forcémment ça ne peut pas marché. Or je l'ai bien mis sur Excel (cf."valeur carte".range("table_département")...Sauriez vous ce que je dois faire ? sachant que je commence à peine à m'y mettre ^^

Ci dessous un des codes:

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
Public Function Dpt_Find(Optional Shape As Variant, Optional Number As Variant) As Range
Set Dpt_Find = Nothing
If IsMissing(Shape) And IsMissing(Number) Then Exit Function
For Each Row In Sheets("Valeurs Carte").Range("Table_Départements").Rows

If Not IsMissing(Number) Then
        If Int(Row.Cells(1, 2).Value) = Number Then
            Set Dpt_Find = Row
            Exit For
        Else
        
        
        
            End If
        End If
    Next Row
End Function

Voici le reste:

Sub Evt_Dpt01_Sel()
Evt_Dpt_Sel (1)
End Sub
Sub Evt_Dpt02_Sel()
Evt_Dpt_Sel (2)
End Sub
Sub Evt_Dpt03_Sel()
Evt_Dpt_Sel (3)
End Sub
Sub Evt_Dpt04_Sel()
Evt_Dpt_Sel (4)
End Sub
Sub Evt_Dpt05_Sel()
Evt_Dpt_Sel (5)
End Sub
Sub Evt_Dpt06_Sel()
Evt_Dpt_Sel (6)
End Sub
Sub Evt_Dpt07_Sel()
Evt_Dpt_Sel (7)
End Sub
Sub Evt_Dpt08_Sel()
Evt_Dpt_Sel (8)
End Sub
Sub Evt_Dpt09_Sel()
Evt_Dpt_Sel (9)
End Sub
Sub Evt_Dpt10_Sel()
Evt_Dpt_Sel (10)
End Sub
Sub Evt_Dpt11_Sel()
Evt_Dpt_Sel (11)
End Sub
Sub Evt_Dpt12_Sel()
Evt_Dpt_Sel (12)
End Sub
Sub Evt_Dpt13_Sel()
Evt_Dpt_Sel (13)
End Sub
Sub Evt_Dpt14_Sel()
Evt_Dpt_Sel (14)
End Sub
Sub Evt_Dpt15_Sel()
Evt_Dpt_Sel (15)
End Sub
Sub Evt_Dpt16_Sel()
Evt_Dpt_Sel (16)
End Sub
Sub Evt_Dpt17_Sel()
Evt_Dpt_Sel (17)
End Sub
Sub Evt_Dpt18_Sel()
Evt_Dpt_Sel (18)
End Sub
Sub Evt_Dpt19_Sel()
Evt_Dpt_Sel (19)
End Sub
Sub Evt_Dpt20_Sel()
Evt_Dpt_Sel (20)
End Sub
Sub Evt_Dpt21_Sel()
Evt_Dpt_Sel (21)
End Sub
Sub Evt_Dpt22_Sel()
Evt_Dpt_Sel (22)
End Sub
Sub Evt_Dpt23_Sel()
Evt_Dpt_Sel (23)
End Sub
Sub Evt_Dpt24_Sel()
Evt_Dpt_Sel (24)
End Sub
Sub Evt_Dpt25_Sel()
Evt_Dpt_Sel (25)
End Sub
Sub Evt_Dpt26_Sel()
Evt_Dpt_Sel (26)
End Sub
Sub Evt_Dpt27_Sel()
Evt_Dpt_Sel (27)
End Sub
Sub Evt_Dpt28_Sel()
Evt_Dpt_Sel (28)
End Sub
Sub Evt_Dpt29_Sel()
Evt_Dpt_Sel (29)
End Sub
Sub Evt_Dpt30_Sel()
Evt_Dpt_Sel (30)
End Sub
Sub Evt_Dpt31_Sel()
Evt_Dpt_Sel (31)
End Sub
Sub Evt_Dpt32_Sel()
Evt_Dpt_Sel (32)
End Sub
Sub Evt_Dpt33_Sel()
Evt_Dpt_Sel (33)
End Sub
Sub Evt_Dpt34_Sel()
Evt_Dpt_Sel (34)
End Sub
Sub Evt_Dpt35_Sel()
Evt_Dpt_Sel (35)
End Sub
Sub Evt_Dpt36_Sel()
Evt_Dpt_Sel (36)
End Sub
Sub Evt_Dpt37_Sel()
Evt_Dpt_Sel (37)
End Sub
Sub Evt_Dpt38_Sel()
Evt_Dpt_Sel (38)
End Sub
Sub Evt_Dpt39_Sel()
Evt_Dpt_Sel (39)
End Sub
Sub Evt_Dpt40_Sel()
Evt_Dpt_Sel (40)
End Sub
Sub Evt_Dpt41_Sel()
Evt_Dpt_Sel (41)
End Sub
Sub Evt_Dpt42_Sel()
Evt_Dpt_Sel (42)
End Sub
Sub Evt_Dpt43_Sel()
Evt_Dpt_Sel (43)
End Sub
Sub Evt_Dpt44_Sel()
Evt_Dpt_Sel (44)
End Sub
Sub Evt_Dpt45_Sel()
Evt_Dpt_Sel (45)
End Sub
Sub Evt_Dpt46_Sel()
Evt_Dpt_Sel (46)
End Sub
Sub Evt_Dpt47_Sel()
Evt_Dpt_Sel (47)
End Sub
Sub Evt_Dpt48_Sel()
Evt_Dpt_Sel (48)
End Sub
Sub Evt_Dpt49_Sel()
Evt_Dpt_Sel (49)
End Sub
Sub Evt_Dpt50_Sel()
Evt_Dpt_Sel (50)
End Sub
Sub Evt_Dpt51_Sel()
Evt_Dpt_Sel (51)
End Sub
Sub Evt_Dpt52_Sel()
Evt_Dpt_Sel (52)
End Sub
Sub Evt_Dpt53_Sel()
Evt_Dpt_Sel (53)
End Sub
Sub Evt_Dpt54_Sel()
Evt_Dpt_Sel (54)
End Sub
Sub Evt_Dpt55_Sel()
Evt_Dpt_Sel (55)
End Sub
Sub Evt_Dpt56_Sel()
Evt_Dpt_Sel (56)
End Sub
Sub Evt_Dpt57_Sel()
Evt_Dpt_Sel (57)
End Sub
Sub Evt_Dpt58_Sel()
Evt_Dpt_Sel (58)
End Sub
Sub Evt_Dpt59_Sel()
Evt_Dpt_Sel (59)
End Sub
Sub Evt_Dpt60_Sel()
Evt_Dpt_Sel (60)
End Sub
Sub Evt_Dpt61_Sel()
Evt_Dpt_Sel (61)
End Sub
Sub Evt_Dpt62_Sel()
Evt_Dpt_Sel (62)
End Sub
Sub Evt_Dpt63_Sel()
Evt_Dpt_Sel (63)
End Sub
Sub Evt_Dpt64_Sel()
Evt_Dpt_Sel (64)
End Sub
Sub Evt_Dpt65_Sel()
Evt_Dpt_Sel (65)
End Sub
Sub Evt_Dpt66_Sel()
Evt_Dpt_Sel (66)
End Sub
Sub Evt_Dpt67_Sel()
Evt_Dpt_Sel (67)
End Sub
Sub Evt_Dpt68_Sel()
Evt_Dpt_Sel (68)
End Sub
Sub Evt_Dpt69_Sel()
Evt_Dpt_Sel (69)
End Sub
Sub Evt_Dpt70_Sel()
Evt_Dpt_Sel (70)
End Sub
Sub Evt_Dpt71_Sel()
Evt_Dpt_Sel (71)
End Sub
Sub Evt_Dpt72_Sel()
Evt_Dpt_Sel (72)
End Sub
Sub Evt_Dpt73_Sel()
Evt_Dpt_Sel (73)
End Sub
Sub Evt_Dpt74_Sel()
Evt_Dpt_Sel (74)
End Sub
Sub Evt_Dpt75_Sel()
Evt_Dpt_Sel (75)
End Sub
Sub Evt_Dpt76_Sel()
Evt_Dpt_Sel (76)
End Sub
Sub Evt_Dpt77_Sel()
Evt_Dpt_Sel (77)
End Sub
Sub Evt_Dpt78_Sel()
Evt_Dpt_Sel (78)
End Sub
Sub Evt_Dpt79_Sel()
Evt_Dpt_Sel (79)
End Sub
Sub Evt_Dpt80_Sel()
Evt_Dpt_Sel (80)
End Sub
Sub Evt_Dpt81_Sel()
Evt_Dpt_Sel (81)
End Sub
Sub Evt_Dpt82_Sel()
Evt_Dpt_Sel (82)
End Sub
Sub Evt_Dpt83_Sel()
Evt_Dpt_Sel (83)
End Sub
Sub Evt_Dpt84_Sel()
Evt_Dpt_Sel (84)
End Sub
Sub Evt_Dpt85_Sel()
Evt_Dpt_Sel (85)
End Sub
Sub Evt_Dpt86_Sel()
Evt_Dpt_Sel (86)
End Sub
Sub Evt_Dpt87_Sel()
Evt_Dpt_Sel (87)
End Sub
Sub Evt_Dpt88_Sel()
Evt_Dpt_Sel (88)
End Sub
Sub Evt_Dpt89_Sel()
Evt_Dpt_Sel (89)
End Sub
Sub Evt_Dpt90_Sel()
Evt_Dpt_Sel (90)
End Sub
Sub Evt_Dpt91_Sel()
Evt_Dpt_Sel (91)
End Sub
Sub Evt_Dpt92_Sel()
Evt_Dpt_Sel (92)
End Sub
Sub Evt_Dpt93_Sel()
Evt_Dpt_Sel (93)
End Sub
Sub Evt_Dpt94_Sel()
Evt_Dpt_Sel (94)
End Sub
Sub Evt_Dpt95_Sel()
Evt_Dpt_Sel (95)
End Sub
Sub Evt_Dpt_971_Sel()
Evt_Dpt_Sel (971)
End Sub
Sub Evt_Dpt_972_Sel()
Evt_Dpt_Sel (972)
End Sub
Sub Evt_Dpt_973_Sel()
Evt_Dpt_Sel (973)
End Sub
Sub Evt_Dpt_974_Sel()
Evt_Dpt_Sel (974)
End Sub
Sub Evt_Dpt_976_Sel()
Evt_Dpt_Sel (976)
End Sub
Sub Evt_Dpt_99_Sel()
'Nouveau département que je veux mettre
Evt_Dpt_Sel (99)
End Sub
Sub Evt_Dpt_Sel(NoDpt As Integer)
Dim DptRow As Range

Set DptRow = Dpt_Find(, NoDpt)

    
        Feuil5.Cells(44, 7) = DptRow.Cells(1, 2).Value
        Feuil5.Cells(44, 8) = DptRow.Cells(1, 4).Value
        Feuil5.Cells(44, 9) = DptRow.Cells(1, 3).Value
        Feuil5.Cells(44, 10) = DptRow.Cells(1, 5).Value

            
            
        
End Sub

Public Sub Refresh()
Dim cel As Range

    Feuil5.Select
        For Each cel In Feuil4.Range("A3:A104")
            ActiveSheet.Shapes(cel.Value).Select
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = cel.Offset(0, 5).Value + 7
        
        Next cel
        [K1].Select
        
       Select Case Feuil3.Range("G20")
           
           
         Case Is = "6"
                 
                Range("P13").Interior.ColorIndex = Feuil2.Range("D11")
                Range("P14").Interior.ColorIndex = Feuil2.Range("D12")
                Range("P15").Interior.ColorIndex = Feuil2.Range("D13")
                Range("P16").Interior.ColorIndex = Feuil2.Range("D14")
                Range("P17").Interior.ColorIndex = Feuil2.Range("D15")
                Range("P18").Interior.ColorIndex = Feuil2.Range("D16")
        
        
        Case Is = "5"
                 
                Range("P13").Interior.ColorIndex = Feuil2.Range("H11")
                Range("P14").Interior.ColorIndex = Feuil2.Range("H12")
                Range("P15").Interior.ColorIndex = Feuil2.Range("H13")
                Range("P16").Interior.ColorIndex = Feuil2.Range("H14")
                Range("P17").Interior.ColorIndex = Feuil2.Range("H15")
                Range("P18").Interior.ColorIndex = Feuil2.Range("H16")
                
        
        Case Is = "4"
                 
                Range("P13").Interior.ColorIndex = Feuil2.Range("L11")
                Range("P14").Interior.ColorIndex = Feuil2.Range("L12")
                Range("P15").Interior.ColorIndex = Feuil2.Range("L13")
                Range("P16").Interior.ColorIndex = Feuil2.Range("L14")
                Range("P17").Interior.ColorIndex = Feuil2.Range("L15")
                Range("P18").Interior.ColorIndex = Feuil2.Range("L16")
    
                
        Case Else
                 Range("P13:P18").Interior.ColorIndex = 0
                 
End Select
End Sub

Si vous avez une idée, ça serait juste trop cool.
Merci d'avoir pris le temps de me lire

**Marc-L** · 24/07/2014, 09h20

Bonjour.

Code :

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

1
2
3
4
5
Function ExistShape(S, Optional Ws As Worksheet) As Boolean
         If Ws Is Nothing Then Set Ws = ActiveSheet
         On Error Resume Next
         ExistShape = IsObject(Ws.Shapes(S))
End Function