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
| Private Sub Calculer_Click()
'déclaration des variables
Dim P1x, P2x, P3x, P1y, P2y, P3y, P1z, P2z, P3z, DETP, X, Y, Z, R, D1R, D2R, D3R, D11, D22, D33, LatRadX, LongRadX, LongX, LatX, DistanceOrtho, l As Double
Dim R1 As Long
Dim D1, D2, D3 As String
Dim H As Range
Dim Ligne As Integer
Dim i As Variant
'calculs pour trouver les coordonnées d'un point à l'aides des infos de la base de données
P1x = Cos(TextBox12.Value) * Cos(TextBox6.Value)
P2x = Cos(TextBox24.Value) * Cos(TextBox18.Value)
P3x = Cos(TextBox36.Value) * Cos(TextBox30.Value)
P1y = Cos(TextBox12.Value) * Sin(TextBox6.Value)
P2y = Cos(TextBox24.Value) * Sin(TextBox18.Value)
P3y = Cos(TextBox36.Value) * Sin(TextBox30.Value)
P1z = Sin(TextBox12.Value)
P2z = Sin(TextBox24.Value)
P3z = Sin(TextBox36.Value)
DETP = (P1x * P2y * P3z) + (P1y * P2z * P3x) + (P1z * P3y * P2x) - (P3x * P2y * P1z) - (P3y * P2z * P1x) - (P2x * P1y * P3z)
'conversion pour pouvoir calculer le cosinus dans X, Y et Z
R1 = 6371
R = CDbl(R1)
D1 = DistanceV1.Value
D2 = DistanceV2.Value
D3 = DistanceV3.Value
D11 = Val(D1)
D22 = Val(D2)
D33 = Val(D3)
D1R = D11 / R
D2R = D22 / R
D3R = D33 / R
X = (1 / DETP) * ((P2y * P3z - P3y * P2z) * Cos(D1R) + (P3y * P1z - P1y * P3z) * Cos(D2R) + (P1y * P2z - P2y * P1z) * Cos(D3R))
Y = (1 / DETP) * ((P3x * P2z - P2x * P3z) * Cos(D1R) + (P1x * P3z - P3x * P1z) * Cos(D2R) + (P2x * P1z - P1x * P2z) * Cos(D3R))
Z = (1 / DETP) * ((P2x * P3y - P3x * P2y) * Cos(D1R) + (P3x * P1y - P1x * P3y) * Cos(D2R) + (P1x * P2y - P2x * P1y) * Cos(D3R))
LatRadX = WorksheetFunction.Asin(Z)
LongRadX = Sgn(Y) * WorksheetFunction.Acos(X / (Sqr(1 - Z ^ 2)))
'résultats des calculs
TextBox43 = LatRadX
TextBox37 = LongRadX
'Calcul et affichage dans la base de données des distances entre le point déterminé par les calculs et toutes les villes de la base de données
For n = 2 To 3582
DistanceOrtho = R * WorksheetFunction.Acos(Cos(TextBox43.Value) * Cos(Range("M" & n)) * Cos(Range("N" & n) - TextBox37.Value) + Sin(TextBox43.Value) * Sin(Range("M" & n)))
Sheets("coordonnées_villes_monde").Range("O" & n).Value = DistanceOrtho
Next
'récupération de la plus petite valeur parmis les distances calculées
l = Application.WorksheetFunction.Min(Range("O2:O3582"))
DistancePX = l
End Sub
Private Sub CommandButton3_Click()
UserForm3.Show
End Sub
Private Sub Enregistrer_Click()
'recherche de la ligne dans laquelle se trouve cette plus petite valeur afin de pouvoir récupérer le pays et la ville
l = Application.WorksheetFunction.Min(Range("O2:O3582"))
For Each i In Worksheets("coordonnées_villes_monde").Range("O2:O3582")
If i = CDbl(l) Then
Set H = Cells.Find(what:=i, LookAt:=xlWhole)
Ligne = H.Row 'pour renvoyer le numéro de ligne
End If
Next
'récupération du pays et de la ville
VilleX = Cells(Ligne, 2).Value
PaysX = Cells(Ligne, 1).Value
End Sub
'REMPLISSAGE VILLES 1
Private Sub ListePays1_Change()
'on vide la combobox
ListeVille1.Clear
'on prend la valeur de la combobox liée au pays et on boucle sur la première colonne pour remplir la combobox liée aux villes
For n = 2 To Worksheets("coordonnées_villes_monde").Range("A4000").End(xlUp).Row
If Range("A" & n) = ListePays1 Then
ListeVille1.AddItem Range("B" & n)
End If
Next n
End Sub
'REMPLISSAGE VILLES 2
Private Sub ListePays2_Change()
'on vide la combobox
ListeVille2.Clear
'on prend la valeur de la combobox liée au pays et on boucle sur la première colonne pour remplir la combobox liée aux villes
For n = 2 To Worksheets("coordonnées_villes_monde").Range("A4000").End(xlUp).Row
If Range("A" & n) = ListePays2 Then
ListeVille2.AddItem Range("B" & n)
End If
Next n
End Sub
'REMPLISSAGE VILLES 3
Private Sub ListePays3_Change()
'on vide la combobox
ListeVille3.Clear
'on prend la valeur de la combobox liée au pays et on boucle sur la première colonne pour remplir la combobox liée aux villes
For n = 2 To Worksheets("coordonnées_villes_monde").Range("A4000").End(xlUp).Row
If Range("A" & n) = ListePays3 Then
ListeVille3.AddItem Range("B" & n)
End If
Next n
End Sub
'REMPLISSAGE COORDONNEES VILLE 1
Private Sub ListeVille1_Change()
'on prend la valeur de la combobox liée aux villes et on boucle pour récupérer la coordonnée lié à la colonne en question pour remplir les textbox des coordonnées
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox1 = Range("I" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox2 = Range("J" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox3 = Range("K" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox4 = Range("L" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox5 = Range("H" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox7 = Range("D" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox8 = Range("E" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox9 = Range("F" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox10 = Range("G" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille1 Then TextBox11 = Range("C" & n)
Next
'On convertit de degrés vers radians et on affiche dans la tesxtbox correspondante
TextBox6 = (TextBox5.Value * WorksheetFunction.Pi) / 180
TextBox12 = (TextBox11.Value * WorksheetFunction.Pi) / 180
End Sub
'REMPLISSAGE COORDONNEES VILLE 2
Private Sub ListeVille2_Change()
'on prend la valeur de la combobox liée aux villes et on boucle pour récupérer la coordonnée lié à la colonne en question pour remplir les textbox des coordonnées
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox13 = Range("I" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox14 = Range("J" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox15 = Range("K" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox16 = Range("L" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox17 = Range("H" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox19 = Range("D" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox20 = Range("E" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox21 = Range("F" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox22 = Range("G" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille2 Then TextBox23 = Range("C" & n)
Next
'On convertit de degrés vers radians et on affiche dans la tesxtbox correspondante
TextBox18 = (TextBox17.Value * WorksheetFunction.Pi) / 180
TextBox24 = (TextBox23.Value * WorksheetFunction.Pi) / 180
End Sub
'REMPLISSAGE COORDONNEES VILLE 3
Private Sub ListeVille3_Change()
'on prend la valeur de la combobox liée aux villes et on boucle pour récupérer la coordonnée lié à la colonne en question pour remplir les textbox des coordonnées
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox25 = Range("I" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox26 = Range("J" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox27 = Range("K" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox28 = Range("L" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox29 = Range("H" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox31 = Range("D" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox32 = Range("E" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox33 = Range("F" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox34 = Range("G" & n)
Next
For n = 2 To Range("B65536").End(xlUp).Row
If Range("B" & n) = ListeVille3 Then TextBox35 = Range("C" & n)
Next
'On convertit de degrés vers radians et on affiche dans la tesxtbox correspondante
TextBox30 = (TextBox29.Value * WorksheetFunction.Pi) / 180
TextBox36 = (TextBox35.Value * WorksheetFunction.Pi) / 180
End Sub
Private Sub Quitter_Click()
'effacer le contenu de la colonne Distance de la feuille et quitter le userform
[O2:O3582].ClearContents
Unload Me
End Sub
' REMPLISSAGE DES COMBOBOX PAYS
Private Sub UserForm_Initialize()
Dim Cell As Range
'Supprime les données existantes dans les ComboBox
Me.ListePays1.Clear
Me.ListePays2.Clear
Me.ListePays3.Clear
'Boucle sur les cellules de la plage A2:A3583 pour alimenter le ComboBox
For Each Cell In Worksheets("coordonnées_villes_monde").Range("A2:A3583")
Me.ListePays1 = Cell
'remplissage sans doublon en comparant avec la valeur précédente
If Me.ListePays1.ListIndex = -1 Then _
Me.ListePays1.AddItem Cell
Next Cell
'Boucle sur les cellules de la plage A2:A3583 pour alimenter le ComboBox
For Each Cell In Worksheets("coordonnées_villes_monde").Range("A2:A3583")
Me.ListePays2 = Cell
'remplissage sans doublon en comparant avec la valeur précédente
If Me.ListePays2.ListIndex = -1 Then _
Me.ListePays2.AddItem Cell
Next Cell
'Boucle sur les cellules de la plage A2:A3583 pour alimenter le ComboBox
For Each Cell In Worksheets("coordonnées_villes_monde").Range("A2:A3583")
Me.ListePays3 = Cell
'remplissage sans doublon en comparant avec la valeur précédente
If Me.ListePays3.ListIndex = -1 Then _
Me.ListePays3.AddItem Cell
Next Cell
End Sub |
Beug code projet vba
Répondre avec citation
Envoyé par joe.levrai
Partager