Voici la feuille de calcul, dans une archive zip, dont il est question dans le document ci-dessus. Elle permet de convertir un code Locator vers des coordonnées latitude longitude, ainsi que le calcul de l’azimut pour orienter une antenne et la distance entre deux points Locator. Pour que le calcul fonctionne, il faut activer le contenu actif pour autoriser l’exécution des macro dans Excel. Un bouton apparait pour ce type de document, il faut cliquer sur activer le contenu :
Le code Visual Basic permettant les conversions :
Function FindLat(ByVal Locator As String) As Double
Dim Field As String
Dim Square As String
Dim SubSquare As String
Dim ExtendedSquare As String
Dim SuperExtendedSquare As String
Dim CodeLength As Integer
Dim Sum As Double
' Extraction des caractères de la latitude
Field = Mid(Locator, 2, 1)
Square = Mid(Locator, 4, 1)
SubSquare = Mid(Locator, 6, 1)
ExtendedSquare = Mid(Locator, 8, 1)
SuperExtendedSquare = Mid(Locator, 10, 1)
' Détection de la longueur du code (nombre de paires)
If Field <> "" Then CodeLength = 1
If Square <> "" Then CodeLength = 2
If SubSquare <> "" Then CodeLength = 3
If ExtendedSquare <> "" Then CodeLength = 4
If SuperExtendedSquare <> "" Then CodeLength = 5
' Conversion en majuscules pour les paires en lettres
Field = UCase(Field)
SubSquare = UCase(SubSquare)
SuperExtendedSquare = UCase(SuperExtendedSquare)
' Conversion des codes ASCII en valeurs décimales, si nécessaire
If CodeLength >= 1 Then Field = Asc(Field) - Asc("A")
If CodeLength >= 2 Then Square = Asc(Square) - Asc("0")
If CodeLength >= 3 Then SubSquare = Asc(SubSquare) - Asc("A")
If CodeLength >= 4 Then ExtendedSquare = Asc(ExtendedSquare) - Asc("0")
If CodeLength >= 5 Then SuperExtendedSquare = Asc(SuperExtendedSquare) - Asc("A")
' Calcul de la somme des paires de codage, plus la moitié d'un carreau de la plus petite paire de codage
Select Case CodeLength
Case 1
Sum = 10 * Field + 5
Case 2
Sum = 10 * Field + Square * 0.5
Case 3
Sum = 10 * Field + Square + SubSquare / 24 + 0.5 / 24
Case 4
Sum = 10 * Field + Square + SubSquare / 24 + ExtendedSquare / 240 + 0.5 / 240
Case 5
Sum = 10 * Field + Square + SubSquare / 24 + ExtendedSquare / 240 + SuperExtendedSquare / 5760 + 0.5 / 5760
End Select
' Retourner la latitude
If CodeLength >= 1 Then FindLat = Round(Sum - 90, 6)
End Function
Function FindLong(ByVal Locator As String) As Double
Dim Field As String
Dim Square As String
Dim SubSquare As String
Dim ExtendedSquare As String
Dim SuperExtendedSquare As String
Dim CodeLength As Integer
Dim Sum As Double
' Extraction des caractères de la longitude
Field = Mid(Locator, 1, 1)
Square = Mid(Locator, 3, 1)
SubSquare = Mid(Locator, 5, 1)
ExtendedSquare = Mid(Locator, 7, 1)
SuperExtendedSquare = Mid(Locator, 9, 1)
' Détection de la longueur du code (nombre de paires)
If Field <> "" Then CodeLength = 1
If Square <> "" Then CodeLength = 2
If SubSquare <> "" Then CodeLength = 3
If ExtendedSquare <> "" Then CodeLength = 4
If SuperExtendedSquare <> "" Then CodeLength = 5
' Conversion en majuscules pour les paires en lettres
Field = UCase(Field)
SubSquare = UCase(SubSquare)
SuperExtendedSquare = UCase(SuperExtendedSquare)
' Conversion des codes ASCII en valeurs décimales, si nécessaire
If CodeLength >= 1 Then Field = Asc(Field) - Asc("A")
If CodeLength >= 2 Then Square = Asc(Square) - Asc("0")
If CodeLength >= 3 Then SubSquare = Asc(SubSquare) - Asc("A")
If CodeLength >= 4 Then ExtendedSquare = Asc(ExtendedSquare) - Asc("0")
If CodeLength >= 5 Then SuperExtendedSquare = Asc(SuperExtendedSquare) - Asc("A")
' Calcul de la somme des paires de codage, plus la moitié d'un carreau de la plus petite paire de codage
Select Case CodeLength
Case 1
Sum = 20 * Field + 5
Case 2
Sum = 20 * Field + 2 * Square + 0.5 * 2
Case 3
Sum = 20 * Field + 2 * Square + SubSquare / 12 + 0.5 / 12
Case 4
Sum = 20 * Field + 2 * Square + SubSquare / 12 + ExtendedSquare / 120 + 0.5 / 120
Case 5
Sum = 20 * Field + 2 * Square + SubSquare / 12 + ExtendedSquare / 120 + SuperExtendedSquare / 2880 + 0.5 / 2880
End Select
' Retourner la longitude
If CodeLength >= 1 Then FindLong = Round(Sum - 180, 6)
End Function
Function FindDistance(ByVal Lat1 As Double, ByVal Long1 As Double, ByVal Lat2 As Double, ByVal Long2 As Double) As Double
Dim r As Double
Dim p As Double
Dim angle As Double
'rayon de la terre en km
r = 6371
'pi / 180, pour conversion en radian
p = WorksheetFunction.Pi / 180
'conversions en radians
Lat1 = Lat1 * p
Lat2 = Lat2 * p
Long1 = Long1 * p
Long2 = Long2 * p
'calcul de l'angle solide au centre, loi des cosinus sphériques
angle = WorksheetFunction.Acos(Sin(Lat1) * Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * Cos(Long2 - Long1))
FindDistance = r * angle
End Function
Function FindDistanceHaversine(ByVal Lat1 As Double, ByVal Long1 As Double, ByVal Lat2 As Double, ByVal Long2 As Double) As Double
Dim r As Double
Dim p As Double
Dim calc As Double
Dim angle As Double
Dim DeltaLat As Double
Dim DeltaLong As Double
'rayon de la terre en km
r = 6371
'pi / 180, pour conversion en radian
p = WorksheetFunction.Pi / 180
'conversions en radians
Lat1 = Lat1 * p
Lat2 = Lat2 * p
Long1 = Long1 * p
Long2 = Long2 * p
DeltaLat = Lat2 - Lat1
DeltaLong = Long2 - Long1
'calcul de l'angle solide au centre, formule de Haversine
calc = Sin(DeltaLat / 2) ^ 2 + Cos(Lat1) * Cos(Lat2) * Sin(DeltaLong / 2) ^ 2
angle = 2 * WorksheetFunction.Atan2(Sqr(1 - calc), Sqr(calc))
FindDistanceHaversine = r * angle
End Function
Function FindStartAzimut(ByVal Lat1 As Double, ByVal Long1 As Double, ByVal Lat2 As Double, ByVal Long2 As Double) As Double
Dim p As Double
Dim calc As Double
Dim angle As Double
Dim DeltaLat As Double
Dim DeltaLong As Double
'pi / 180, pour conversion en radian
p = WorksheetFunction.Pi / 180
'conversions en radians
Lat1 = Lat1 * p
Lat2 = Lat2 * p
Long1 = Long1 * p
Long2 = Long2 * p
DeltaLong = Long2 - Long1
'calcul de l'azimut de départ
FindStartAzimut = WorksheetFunction.Atan2(Cos(Lat1) * Sin(Lat2) - Sin(Lat1) * Cos(Lat2) * Cos(DeltaLong), Sin(DeltaLong) * Cos(Lat2))
'conversion -180° à +180° vers 0 à 360°
FindStartAzimut = ModuloFP((FindStartAzimut / p), 360)
End Function
Function FindEndAzimut(ByVal Lat2 As Double, ByVal Long2 As Double, ByVal Lat1 As Double, ByVal Long1 As Double) As Double
Dim p As Double
Dim calc As Double
Dim angle As Double
Dim DeltaLat As Double
Dim DeltaLong As Double
'pi / 180, pour conversion en radian
p = WorksheetFunction.Pi / 180
'conversions en radians
Lat1 = Lat1 * p
Lat2 = Lat2 * p
Long1 = Long1 * p
Long2 = Long2 * p
DeltaLong = Long2 - Long1
'calcul de l'azimut de départ
FindEndAzimut = WorksheetFunction.Atan2(Cos(Lat1) * Sin(Lat2) - Sin(Lat1) * Cos(Lat2) * Cos(DeltaLong), Sin(DeltaLong) * Cos(Lat2))
'conversion -180° à +180° vers 0 à 360°
FindEndAzimut = ModuloFP((FindEndAzimut / p - 180), 360)
End Function
Function FindReturnAzimut(ByVal Lat2 As Double, ByVal Long2 As Double, ByVal Lat1 As Double, ByVal Long1 As Double) As Double
Dim p As Double
Dim calc As Double
Dim angle As Double
Dim DeltaLat As Double
Dim DeltaLong As Double
'pi / 180, pour conversion en radian
p = WorksheetFunction.Pi / 180
'conversions en radians
Lat1 = Lat1 * p
Lat2 = Lat2 * p
Long1 = Long1 * p
Long2 = Long2 * p
DeltaLong = Long2 - Long1
'calcul de l'azimut de départ
FindReturnAzimut = WorksheetFunction.Atan2(Cos(Lat1) * Sin(Lat2) - Sin(Lat1) * Cos(Lat2) * Cos(DeltaLong), Sin(DeltaLong) * Cos(Lat2))
'conversion -180° à +180° vers 0 à 360°
FindReturnAzimut = ModuloFP((FindReturnAzimut / p), 360)
End Function
Function DD_to_DMS(ByVal DD As Double, ByVal Precision As Integer) As String
Dim Partie_decimale_degres
Dim Partie_decimale_minutes
Dim Partie_entiere_degres
Dim Partie_entiere_minutes
Dim Minutes
Dim Secondes
Dim DD_abs
Dim Signe
'supression du signe
DD_abs = Abs(DD)
'Séparation des parties entière et décimale des degrés
Partie_decimale_degres = DD_abs - Int(DD_abs)
Partie_entiere_degres = Int(DD_abs)
'Ajout d'un ou deux zéro non significatifs si besoin sur les degrés
If Partie_entiere_degres < 10 Then
Partie_entiere_degres = "00" & Partie_entiere_degres
ElseIf Partie_entiere_degres < 100 Then
Partie_entiere_degres = "0" & Partie_entiere_degres
End If
'conversion en minutes
Minutes = Partie_decimale_degres * 60
'Séparation des parties entière et décimale des minutes
Partie_decimale_minutes = Minutes - Int(Minutes)
Partie_entiere_minutes = Int(Minutes)
'Ajout d'un zéro non significatif si besoin sur les minutes
If Partie_entiere_minutes < 10 Then Partie_entiere_minutes = "0" & Partie_entiere_minutes
'Conversion en secondes et arrondi
Secondes = WorksheetFunction.RoundDown(Partie_decimale_minutes * 60, Precision)
'Ajout d'un zéro non significatif si besoin sur les secondes
If Secondes < 10 Then Secondes = "0" & Secondes
'Remise en place du signe et concatenation
If Sgn(DD) = -1 Then Signe = "-"
DD_to_DMS = Signe & Partie_entiere_degres & "° " & Partie_entiere_minutes & "' " & Secondes & """"
End Function
Function ModuloFP(Numerateur As Double, Denominateur As Double) As Double
ModuloFP = Numerateur - Denominateur * Int(Numerateur / Denominateur)
End Function