[vba excel] calculer la distance entre deux coordonnées géographiques

Soyez le premier à donner votre avis sur cette source.

Vue 22 993 fois - Téléchargée 4 129 fois

Description

Vous sélectionnez les codes postaux de vos villes de départ et d'arrivée, et vous obtiendrez la distance à vol d'oiseau approximative entre ces deux villes.

Le classeur renferme la liste de plus de 35000 communes de France avec leur codes postaaux et leurs coordonnées géographiques (latitude et longitude).
Ces données, que j'avais collectées il y a de nombreuses années, ne sont surement pas à jour et comportent surement des lacunes.

Points intéressant de ce code :
- Création de DropDownList (non OCX) dynamiquement et affectation évènement à une procédure VBA
- Manipulation de Range
- Calcul de distance approximative, car la terre n'est pas ronde.

Source / Exemple :


Créée sous Excel 2003, mais testé sans encombre sous Office 2007 et 2010.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
425
Date d'inscription
samedi 11 juillet 2009
Statut
Membre
Dernière intervention
28 octobre 2016
1
Merciii
Messages postés
425
Date d'inscription
samedi 11 juillet 2009
Statut
Membre
Dernière intervention
28 octobre 2016
1
ok
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
68
Par contre, il te manquera la base de données répertoriant les noms de ville, les codes postaux et les coordonnées géographiques - impossible de les lister là.
Messages postés
425
Date d'inscription
samedi 11 juillet 2009
Statut
Membre
Dernière intervention
28 octobre 2016
1
oO merciii :P
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
68
Oui, voilà le code principal, il te suffira de remplacer les références aux cellule sExcel par tes valeurs numériques :
Private Sub CalculeDistance()

' Calcule la distance entre deux coordonnées géographiques
' Les coordonnées Latitude et Longitude doivent être exprimées en degrés décimaux
' (et pas en degrés, minutes, secondes)

Dim gRayonMoyen As Single
Dim gLatitude1 As Single
Dim gLongitude1 As Single
Dim gLatitude2 As Single
Dim gLongitude2 As Single
Dim gDistance As Single

If Not (IsEmpty(Range("Lat1")) Or _
IsEmpty(Range("Long1")) Or _
IsEmpty(Range("Lat2")) Or _
IsEmpty(Range("Long2"))) Then
If Range("Lat1").Value = Range("Lat2").Value And _
Range("Long1").Value = Range("Long2").Value Then
Range("Distance").Value = 0
Else
gRayonMoyen = 6371 ' de la terre, en km
gPi = 4 * Atn(1)
' Convertit les degrés en radians
gLatitude1 = Range("Lat1").Value / 180 * gPi
gLongitude1 = Range("Long1").Value / 180 * gPi
gLatitude2 = Range("Lat2").Value / 180 * gPi
gLongitude2 = Range("Long2").Value / 180 * gPi
' Calcul
gDistance = ACos((Sin(gLatitude1) * Sin(gLatitude2)) _
+ (Cos(gLatitude1) * Cos(gLatitude2) * Cos(gLongitude1 - gLongitude2))) _
* gRayonMoyen
' Affichage
Range("Distance").Value = gDistance
End If
End If

End Sub

Private Function ACos(AngleRandian As Single) As Single
' ArcCosinus
ACos = Atn((AngleRandian * (-1)) _
/ Sqr(((AngleRandian * (-1)) * AngleRandian) + 1)) _
+ (gPi / 2)
End Function
Afficher les 15 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.