Посмотри это, может поможет, из десятичных в градусы-мин-сек.:
Для поля широты
Dim sField
Dim dY As Double
Dim dD As Double, dM As Double, dS As Double
Dim dM1 As Double, dS1 As Double
Dim sD As String, sM As String, sS As String
Dim sSuf As String
Dim sType As String
Dim sDMS As String
Dim sDeg As String, sMin As String, sSec As String
Dim iNumDec As Integer
sField = [y]
sDeg = "d" 'Character after degrees
sMin = Chr(39) 'Character after minutes
sSec = Chr(34) 'Character after seconds
iNumDec = 2 'number of decimal places for the seconds (minutes)
sType = "dms" 'result type "dms" - Degrees-Minutes-Seconds, "dm" - Degrees-Minutes
dY = sField
If dY >= 0 Then
sSuf = "N"
Else
sSuf = "S"
End If
dY = Abs(dY)
dD = Int(dY)
sD = CStr(dD)
dM = (dY - dD) * 60
dM1 = Int(dM)
If (sType = "dms") Then
If (Len(CStr(dM1)) = 1) Then
sM = "0" & CStr(dM1)
Else
sM = CStr(dM1)
End If
dS = FormatNumber(((dM - dM1) * 60), iNumDec)
dS1 = Int(dS)
If (Len(CStr(dS1)) = 1) Then
sS = "0" & CStr(dS)
Else
sS = CStr(dS)
End If
sDMS = sD & sDeg & sM & sMin & sS & sSec & sSuf
Else
sM = CStr(FormatNumber(dM, iNumDec))
sDMS = sD & sDeg & sM & sMin & sSuf
End If
Для долготы
Dim sField
Dim dX As Double
Dim dD As Double, dM As Double, dS As Double
Dim dM1 As Double, dS1 As Double
Dim sD As String, sM As String, sS As String
Dim sSuf As String
Dim sType As String
Dim sDMS As String
Dim sDeg As String, sMin As String, sSec As String
Dim iNumDec As Integer
sField = [x]
sDeg = "d" 'Character after degrees
sMin = Chr(39) 'Character after minutes
sSec = Chr(34) 'Character after seconds
iNumDec = 2 'number of decimal places for the seconds (minutes)
sType = "dms" 'result type "dms" - Degrees-Minutes-Seconds, "dm" - Degrees-Minutes
dX = sField
If dX >= 0 Then
sSuf = "E"
Else
sSuf = "W"
End If
dX = Abs(dX)
dD = Int(dX)
sD = CStr(dD)
dM = (dX - dD) * 60
dM1 = Int(dM)
If (sType = "dms") Then
If (Len(CStr(dM1)) = 1) Then
sM = "0" & CStr(dM1)
Else
sM = CStr(dM1)
End If
dS = FormatNumber(((dM - dM1) * 60), iNumDec)
dS1 = Int(dS)
If (Len(CStr(dS1)) = 1) Then
sS = "0" & CStr(dS)
Else
sS = CStr(dS)
End If
sDMS = sD & sDeg & sM & sMin & sS & sSec & sSuf
Else
sM = CStr(FormatNumber(dM, iNumDec))
sDMS = sD & sDeg & sM & sMin & sSuf
End If
Из dms в dd
Dim sField
Dim sDMS As String, sS As String, sSuf As String
Dim sList
Dim i As Integer, j As Integer
Dim iDec As Integer, iNum As Integer
Dim dD As Double, dM As Double, dS As Double, dDD As Double
Dim bReplace As Boolean
sField = [Long]
sDMS = sField
If Len(Trim(sDMS)) = 0 Then
dDD = 0
Else
iDec = 0
iNum = 0
For i = 1 To Len(sDMS)
sS = Mid(sDMS, i, 1)
If Not IsNumeric(sS) Then
If sS = "." Then
If Not iDec = 0 Then
bReplace = True
Else
bReplace = False
End If
iDec = iDec + 1
ElseIf UCase(sS) = "S" Or UCase(sS) = "N" Or UCase(sS) = "W" Or UCase(sS) = "E" Then
sSuf = UCase(sS)
bReplace = True
Else
bReplace = True
End If
If bReplace Then
If iNum > 0 Then
Mid(sDMS, i, 1) = ","
Else
Mid(sDMS, i, 1) = " "
End If
End If
Else
iNum = iNum + 1
End If
Next i
sList = Split(sDMS, ",")
Dim iLen As Integer
If UBound(sList) = 0 Then
sDMS = sList(0)
iLen = Len(sDMS)
If iLen >= 4 Then
dS = CDbl(Mid(sDMS, iLen - 1, 2))
dM = CDbl(Mid(sDMS, iLen - 3, 2))
sDMS = Left(sDMS, (iLen - 4))
If (Len(sDMS) > 2) Then
dD = CDbl(Right(sDMS, 3))
ElseIf (Len(sDMS) = 0) Then
dD = 0#
Else
dD = CDbl(sDMS)
End If
Else
dDD = 0
End If
dDD = dD + dM / 60# + dS / 3600#
Else
j = 0
dD = 0#
dM = 0#
dS = 0#
For i = 0 To UBound(sList)
If IsNumeric(sList(i)) Then
If j = 0 Then
dD = CDbl(sList(i))
j = j + 1
ElseIf j = 1 Then
dM = CDbl(sList(i))
j = j + 1
ElseIf j = 2 Then
dS = CDbl(sList(i))
j = j + 1
End If
End If
Next i
dDD = dD + dM / 60# + dS / 3600#
End If
If dDD < -180# Or dDD > 180# Then
dDD = 0#
End If
If sSuf = "S" Or sSuf = "W" Then
dDD = dDD * -1#
End If
End If
