CONVERSION GPS
cs_JLN
Messages postés
371
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
17 juin 2013
-
10 févr. 2013 à 09:35
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013 - 14 févr. 2013 à 22:13
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013 - 14 févr. 2013 à 22:13
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/54941-conversion-gps
https://codes-sources.commentcamarche.net/source/54941-conversion-gps
14 févr. 2013 à 22:13
14 févr. 2013 à 15:01
c'est un très joli code, vraiment du bon travail, moi-même, je n'ai pas été capable de faire mieux, mais je débute.
Merci pour le partage.
11 févr. 2013 à 09:38
'-------------------------------------------------------------------------
'Convertion des minutes et secondes en fractions décimales de degré
'Conversion degrés en degrés décimaux
'---------------------------------------------------------------------------
Public Function Deg2Decim(ByVal DegresLiteral As String, Optional format As String = "dd°mm'ss.ss'' N-S-E-W") As Double
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim Orientation As String
Dim Coef As Integer
Dim i As Integer
Dim Multi As Integer
Dim tabTmp() As String
'Formulation générale Ex: latitude (degrés décimaux) = degrés + (minutes / 60) + (secondes / 3600)
'EX: 45° 53' 36" > 45 + (53 / 60) + (36 / 3600) = 45,893333...
Coef = 1
DegresLiteral = Trim(DegresLiteral)
If Right(DegresLiteral, 1) Like "N" Then
Orientation = "N"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = 1
ElseIf Right(DegresLiteral, 1) Like "S" Then
Orientation = "S"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = -1
ElseIf Right(DegresLiteral, 1) Like "E" Then
Orientation = "E"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = 1
ElseIf Right(DegresLiteral, 1) Like "W" Or Right(DegresLiteral, 1) Like "O" Then
Orientation = "W"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = -1
End If
If Left(DegresLiteral, 1) = "-" Then
DegresLiteral = Trim(Mid(DegresLiteral, 2))
Coef = -1
End If
If Left(DegresLiteral, 1) = "+" Then
DegresLiteral = Trim(Mid(DegresLiteral, 2))
Coef = 1
End If
DegresLiteral = Replace(DegresLiteral, "°", " ")
DegresLiteral = Replace(DegresLiteral, "d", " ", , , 1)
DegresLiteral = Replace(DegresLiteral, ",", " ")
DegresLiteral = Replace(DegresLiteral, "'", " ")
DegresLiteral = Replace(DegresLiteral, "m", " ", , , 1)
DegresLiteral = Replace(DegresLiteral, """", " ")
DegresLiteral = Replace(DegresLiteral, "s", " ", , , 1)
DegresLiteral = Replace(DegresLiteral, "''", " ", , , 1)
Do While InStr(1, DegresLiteral, " ") > 0
DegresLiteral = Replace(DegresLiteral, " ", " ")
Loop
tabTmp = Split(DegresLiteral, " ", , 1)Err.Clear: i -1: i UBound(tabTmp)
If i > -1 Then
Multi = LBound(tabTmp) If Multi 0 Then Multi 1
For i = LBound(tabTmp) To UBound(tabTmp)
If Multi = 1 Then
Deg2Decim = Deg2Decim + (Val(tabTmp(i)) * 1) ' + (Val(tabTmp(1)) / 60) + (Val(tabTmp(2)) / 3600)
ElseIf Multi = 2 Then
Deg2Decim = Deg2Decim + (Val(tabTmp(i)) / 60)
ElseIf Multi = 3 Then
Deg2Decim = Deg2Decim + (Val(tabTmp(i)) / 3600)
Else
Exit For
End If
Multi = Multi + 1
Next
Else
Deg2Decim = 0
End If
Deg2Decim = Round(Coef * Deg2Decim, 8)
End Function
'-------------------------------------------------------------------------
'Conversion des degrés décimaux en degres, minutes, secondes.centiemes
' dd.dddd => dd°mm'ss.ss''
'---------------------------------------------------------------------------
Public Function DegDecim2DegMinSec(ByVal DegresDecim As String, Optional FormatEntree As String = "dd.dddd°") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim iCardinal As Integer
On Error Resume Next
'
' Exemple : soit une longitude de 121,135°
' 1.Le nombre avant la virgule indique les degrés ? 121°
' 2.Multiplier le nombre après la virgule par 60 ? 0,135 * 60 = 8,1
' 3.Le nombre avant la virgule devient la minute (8')
' 4.Multiplier le nombre après la virgule par 60 ? 0,1 * 60 = 6
' 5.Le résultat correspond aux secondes (6").
' 6.Notre longitude sera de 121° 8' 6"
DegresDecim = Trim(DegresDecim)
DegresDecim = Replace(Replace(Replace(DegresDecim, "'", " "), "°", " "), "d", "", , , 1)
'suppression doubles espaces
Do While InStr(1, DegresDecim, " ") > 0
DegresDecim = Replace(DegresDecim, " ", " ")
Loop
If Left(DegresDecim, 1) = "-" Or Left(DegresDecim, 1) Like "S" Or Left(DegresDecim, 1) Like "O" Or Left(DegresDecim, 1) Like "W" Then
iCardinal = -1
DegresDecim = Trim(Mid(DegresDecim, 2))
End If
If Left(DegresDecim, 1) = "+" Or Left(DegresDecim, 1) Like "N" Or Left(DegresDecim, 1) Like "E" Then
iCardinal = 1
DegresDecim = Trim(Mid(DegresDecim, 2))
End If
If Right(DegresDecim, 1) Like "E" Or Right(DegresDecim, 1) Like "N" Then
iCardinal = 1
DegresDecim = Trim(Mid(DegresDecim, 1, Len(DegresDecim) - 1))
End If
If Right(DegresDecim, 1) Like "O" Or Right(DegresDecim, 1) Like "W" Or Right(DegresDecim, 1) Like "S" Then
iCardinal = -1
DegresDecim = Trim(Mid(DegresDecim, 1, Len(DegresDecim) - 1))
End If
DegresDecim = Abs(CDbl(DegresDecim))
Deg = Int(CDbl(DegresDecim))
reste = Round(CDbl(DegresDecim) - Deg, 12)
Min = Int(reste * 60)
reste = Round((reste * 60) - Min, 12)
Sec = Int(reste * 60)
reste = Round((reste * 60) - Int(reste * 60), 12)
'
DegDecim2DegMinSec = format(Deg, "000") & "°" & format(Min, "00") & "'" & Sec + Round(reste, 2) & "''"If iCardinal -1 Then DegDecim2DegMinSec "-" & DegDecim2DegMinSec
End Function
'-------------------------------------------------------------------------
'Conversion des degres, minutes, secondes.centiemes en Degres Decimaux
' dd°mm'ss.ss'' => dd.dddddd°
'---------------------------------------------------------------------------
Public Function DegMinSec2DegDecim(ByVal DegMinSec As String, Optional FormatEntree As String = "dd°mm'ss.ss''") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim ttmp() As String
Dim iCardinal As Integer
'
iCardinal = 1
DegMinSec = Trim(DegMinSec)
If Left(DegMinSec, 1) = "-" Or Left(DegMinSec, 1) Like "S" Or Left(DegMinSec, 1) Like "O" Or Left(DegMinSec, 1) Like "W" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Left(DegMinSec, 1) = "+" Or Left(DegMinSec, 1) Like "N" Or Left(DegMinSec, 1) Like "E" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Right(DegMinSec, 1) Like "E" Or Right(DegMinSec, 1) Like "N" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
If Right(DegMinSec, 1) Like "O" Or Right(DegMinSec, 1) Like "W" Or Right(DegMinSec, 1) Like "S" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
DegMinSec = Replace(Replace(Replace(Replace(Replace(Replace(DegMinSec, "'", " "), " ", " "), "°", " "), "m", " ", , , 1), "d", " ", , , 1), "s", " ", , , 1)
'suppression doubles espaces
Do While InStr(1, DegMinSec, " ") > 0
DegMinSec = Replace(DegMinSec, " ", " ")
Loop
ttmp = Split(DegMinSec, " ")
Deg = Val(ttmp(0))
Min = Round(CDbl(ttmp(1)) / 60, 12)
Sec = Round(CDbl(ttmp(2)) / 3600, 12)
'
DegMinSec2DegDecim = format(Round(Deg + Min + Sec, 8) * iCardinal, "000.00000000")
End Function
'-------------------------------------------------------------------------
'Conversion des degrés avec Minutes décimales en degres, minutes, secondes.centiemes
'DD°MM.mmmm' > DD°MM'SS.ss''
'---------------------------------------------------------------------------
Public Function DegMinDecim2DegMinSec(ByVal DegMinDecim As String, Optional FormatEntree As String = "DD°MM.mmmm") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim tabTmp() As String
Dim iCardinal As Integer
'Exemple : soit une longitude de 1°21.135 ou 1 21.135
' 1.Le Premier Groupe de Nombre Indique les Degres (1°)
' 2.Le second Groupe de nombre indique les minutes décimales
' 3.La partie entiere represente les Minutes (21')
' 4.Multiplier la Partie décimale par 60 ? 0,135 * 60 = 8,1
' 5.Le résultat correspond aux secondes (8.1").
' 6.Notre longitude sera de 1° 21' 8.1''"
iCardinal = 1
DegMinDecim = Trim(DegMinDecim)
If Left(DegMinDecim, 1) = "-" Or Left(DegMinDecim, 1) Like "S" Or Left(DegMinDecim, 1) Like "O" Or Left(DegMinDecim, 1) Like "W" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Left(DegMinDecim, 1) = "+" Or Left(DegMinDecim, 1) Like "N" Or Left(DegMinDecim, 1) Like "E" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Right(DegMinDecim, 1) Like "E" Or Right(DegMinDecim, 1) Like "N" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
ElseIf Right(DegMinDecim, 1) Like "O" Or Right(DegMinDecim, 1) Like "W" Or Right(DegMinDecim, 1) Like "S" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
End If
DegMinDecim = Replace(Trim(DegMinDecim), "°", " ", , , 1)
DegMinDecim = Replace(Trim(DegMinDecim), ",", " ", , , 1)
'supprimer les espaces doubles
Do While InStr(1, DegMinDecim, " ") > 0
DegMinDecim = Replace(DegMinDecim, " ", " ")
Loop
'Reconstruire la valeur en DD°MM'SS.ss''
tabTmp = Split(DegMinDecim, " ", , 1)
Deg = format(Val(tabTmp(0)), "000")
Min = format(Int(Val(tabTmp(1))), "00")
Sec = CStr(Round(((Val(tabTmp(1)) - Val(Min)) * 60), 2))
'
DegMinDecim2DegMinSec = Deg & "°" & Min & "'" & Sec & "''"If iCardinal -1 Then DegMinDecim2DegMinSec "-" & DegMinDecim2DegMinSec
End Function
'-------------------------------------------------------------------------
'Conversion des degrés avec Minutes décimales en degres décimaux
'DD°MM.mmmm' > DD.dddddd°
'---------------------------------------------------------------------------
Public Function DegMinDecim2DegDecim(ByVal DegMinDecim As String, Optional FormatEntree As String = "DD°MM.mmmm") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim tabTmp() As String
Dim iCardinal As Integer
'Exemple : soit une longitude de 1°21.135 ou 1 21.135
' 1.Le Premier Groupe de Nombre Indique les Degres (1°)
' 2.Le second Groupe de nombre indique les minutes décimales
' 3.Diviser les minutes décimales par 60 => 21,135 / 60 = 0.35225
' 4.Ajouter aux degrés => 1+0.35225 =1.35225
' 5.Notre longitude sera de 1.35225°
iCardinal = 1
DegMinDecim = Trim(DegMinDecim)
If Left(DegMinDecim, 1) = "-" Or Left(DegMinDecim, 1) Like "S" Or Left(DegMinDecim, 1) Like "O" Or Left(DegMinDecim, 1) Like "W" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Left(DegMinDecim, 1) = "+" Or Left(DegMinDecim, 1) Like "N" Or Left(DegMinDecim, 1) Like "E" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Right(DegMinDecim, 1) Like "E" Or Right(DegMinDecim, 1) Like "N" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
ElseIf Right(DegMinDecim, 1) Like "O" Or Right(DegMinDecim, 1) Like "W" Or Right(DegMinDecim, 1) Like "S" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
End If
DegMinDecim = Replace(Trim(DegMinDecim), "°", " ", , , 1)
DegMinDecim = Replace(Trim(DegMinDecim), ",", " ", , , 1)
'supprimer les espaces doubles
Do While InStr(1, DegMinDecim, " ") > 0
DegMinDecim = Replace(DegMinDecim, " ", " ")
Loop
'Reconstruire la valeur en DD.dddddd°
tabTmp = Split(DegMinDecim, " ", , 1)
Deg = Val(tabTmp(0))
Min = Val(tabTmp(1)) / 60
'
DegMinDecim2DegDecim = format(Round(Deg + Min, 8), "000.00000000") & "°"If iCardinal -1 Then DegMinDecim2DegDecim "-" & DegMinDecim2DegDecim
End Function
'-------------------------------------------------------------------------
'Conversion des degrés décimaux en degrés avec Minutes décimales
'DD.dddd' > DD°MM.mmmm''
'---------------------------------------------------------------------------
Public Function DegDecim2DegMinDecim(ByVal DegDecim As String, Optional FormatEntree As String = "DD.dddd") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim tabTmp() As String
Dim iCardinal As Integer
On Error Resume Next
'Exemple : soit une longitude de 1.595°
' 1.Le Premier Groupe de Nombre Indique les Degres entiers (1°)
' 2.Le second Groupe de nombre indique les degrés décimaux (0.595)
' 4.Multiplier la Partie décimale par 60 ? 0.595 * 60 = 35.7000
' 5.Le résultat correspond aux minutes décimales (35.7000').
' 6.Notre longitude sera de 1°35.7000' "
iCardinal = 1
DegDecim = Trim(DegDecim)
If Left(DegDecim, 1) = "-" Or Left(DegDecim, 1) Like "S" Or Left(DegDecim, 1) Like "O" Or Left(DegDecim, 1) Like "W" Then
iCardinal = -1
DegDecim = Mid(DegDecim, 2)
ElseIf Left(DegDecim, 1) = "+" Or Left(DegDecim, 1) Like "N" Or Left(DegDecim, 1) Like "E" Then
iCardinal = 1
DegDecim = Mid(DegDecim, 2)
ElseIf Right(DegDecim, 1) Like "E" Or Right(DegDecim, 1) Like "N" Then
iCardinal = 1
DegDecim = Mid(DegDecim, 1, Len(DegDecim) - 1)
ElseIf Right(DegDecim, 1) Like "O" Or Right(DegDecim, 1) Like "W" Or Right(DegDecim, 1) Like "S" Then
iCardinal = -1
DegDecim = Mid(DegDecim, 1, Len(DegDecim) - 1)
End If
DegDecim = Abs(CDbl(Trim(DegDecim)))
'Reconstruire la valeur en DD°MM'SS.ss''
Deg = Int(CDbl(DegDecim))
Min = Round((CDbl(DegDecim) - Deg) * 60, 12)
'
DegDecim2DegMinDecim = format(Deg, "00") & "°" & format(Min, "00.00000000")If iCardinal -1 Then DegDecim2DegMinDecim "-" & DegDecim2DegMinDecim
End Function
'-------------------------------------------------------------------------
'Conversion des degres, minutes, secondes.centiemes en Degres et Minutes décimales
' dd°mm'ss.ss'' => dd°mm.mmmmmm'
'---------------------------------------------------------------------------
Public Function DegMinSec2DegMinDecim(ByVal DegMinSec As String, Optional FormatEntree As String = "dd°mm'ss.ss''") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim ttmp() As String
Dim iCardinal As Integer
'
iCardinal = 1
DegMinSec = Trim(DegMinSec)
DegMinSec = Replace(Replace(DegMinSec, "°", " "), "d", " ")
'suppression doubles espaces
Do While InStr(1, DegMinSec, " ") > 0
DegMinSec = Replace(DegMinSec, " ", " ")
Loop
DegMinSec = Replace(Replace(DegMinSec, "'", " "), " ", " ")
If Left(DegMinSec, 1) = "-" Or Left(DegMinSec, 1) Like "S" Or Left(DegMinSec, 1) Like "O" Or Left(DegMinSec, 1) Like "W" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Left(DegMinSec, 1) = "+" Or Left(DegMinSec, 1) Like "N" Or Left(DegMinSec, 1) Like "E" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Right(DegMinSec, 1) Like "E" Or Right(DegMinSec, 1) Like "N" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
If Right(DegMinSec, 1) Like "O" Or Right(DegMinSec, 1) Like "W" Or Right(DegMinSec, 1) Like "S" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
ttmp = Split(DegMinSec, " ")
Deg = Val(ttmp(0))
Min = Round(CDbl(ttmp(1)), 12)
Sec = Round(CDbl(ttmp(2)) / 60, 12)
'
DegMinSec2DegMinDecim = format(Deg * iCardinal, "00") & "°" & format(Round(Min + Sec, 8), "00.00000000") & "'"
End Function
10 févr. 2013 à 09:35