Microsoft 365 formule pour transformer des points lambert2

Function ProjecStéréo(ByVal Lat As Double, ByVal Lon As Double, _
   Optional ByVal LatRéf = 46.875, Optional ByVal LonRéf As Double = 1.625) As Variant
   Dim XProj As Double, YProj As Double
   CalcProjecStéréo XProj, YProj, Lat, Lon, LatRéf, LonRéf
   ProjecStéréo = Array(XProj, YProj)
   End Function
Sub CalcProjecStéréo(XProj As Double, YProj As Double, ByVal Lat As Double, ByVal Lon As Double, _
      Optional ByVal LatRéf As Double = 46.875, Optional ByVal LonRéf As Double = 1.625)
   Dim CosLatRéf As Double, SinLatRéf As Double, X As Double, Y As Double, Z As Double, Zr As Double, Éch As Double
   Lat = Rad(Lat): Lon = Rad(Lon - LonRéf): LatRéf = Rad(LatRéf): SinLatRéf = Sin(LatRéf): CosLatRéf = Cos(LatRéf)
   Y = Sin(Lat): Z = Cos(Lat): X = Sin(Lon) * Z: Z = Cos(Lon) * Z
   Zr = Z * CosLatRéf + Y * SinLatRéf: Y = Y * CosLatRéf - Z * SinLatRéf
   Éch = 2 / (Zr + 1) * 6368: XProj = X * Éch: YProj = Y * Éch
   End Sub
Function Dist(ByVal Lat1 As Double, ByVal Lon1 As Double, ByVal Lat2 As Double, ByVal Lon2 As Double) As Double
   Lat1 = Rad(Lat1): Lon1 = Rad(Lon1): Lat2 = Rad(Lat2): Lon2 = Rad(Lon2)
   Dist = ACos(Sin(Lat1) * Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * Cos(Lon1 - Lon2)) * 6371
   End Function
Private Function Rad(ByVal Deg As Double) As Double
   Const K = 14964008 / 857374503: Rad = Deg * K
   End Function
Private Function ACos(ByVal X As Double) As Double
   On Error Resume Next
   Const Pi÷2 = 122925461 / 78256779: ACos = Atn(-X / Sqr(1 - X * X)) + Pi÷2
   End Function

' Définition du type personnalisé pour les coordonnées longitude et latitude
Public Type Coordinates
    Longitude As Double
    Latitude As Double
End Type

' Fonction de conversion Lambert 2 vers WGS84 avec un retour de type "Coordinates"
Function LambertToWGS84(X As Double, Y As Double) As Coordinates
    Dim result As Coordinates
    
    ' Constantes de conversion
    Dim lambda0 As Double
    Dim latiso As Double
    Dim N As Double
    Dim C As Double
    Dim Xs As Double
    Dim Ys As Double
    Dim R As Double
    Dim gamma As Double
    Dim omega As Double
    Dim phi As Double
    
    ' Assignation des constantes (à remplacer par les valeurs appropriées)
    lambda0 = 0.04079234433
    latiso = 0.08181919106
    N = 0.7256077650
    C = 11745793.39
    Xs = 600000
    Ys = 8199695.768
    R = 6378137
    gamma = 1.00335655146887969442
    omega = 0.08181919106
    phi = 49.8333333333333333
    
    ' Conversion Lambert 2 en Lambert 93
    X = X - Xs
    Y = Y - Ys
    Dim LongRad As Double
    Dim LatRad As Double
    LongRad = lambda0 + ATn(X / (C - Y))
    Dim phi_1 As Double
    Dim latiso_1 As Double
    phi_1 = 2 * ATn(Exp(Y / N)) - Pi / 2
    latiso_1 = Log(Tn(Pi / 4 + phi_1 / 2) * ((1 - omega * Sn(phi_1)) / (1 + omega * Sn(phi_1))) ^ (omega / 2))
    
    ' Conversion Lambert 93 en WGS84
    LongRad = LongRad / gamma
    LatRad = ATn(Exp(latiso_1)) * 2 - Pi / 2
    
    ' Attribution des valeurs de longitude et de latitude au résultat
    result.Longitude = LongRad
    result.Latitude = LatRad
    
    LambertToWGS84 = result
End Function

' Exemple d'utilisation
Sub TestLambertToWGS84()
    Dim X As Double
    Dim Y As Double
    Dim coords As Coordinates
    
    X = 373631
    Y = 409436
    
    coords = LambertToWGS84(X, Y)
    
    MsgBox "Longitude: " & coords.Longitude & vbCrLf & "Latitude: " & coords.Latitude
End Sub