Hello Friends,
I'm facing problem with a vb program, which will convert decimal degrees in degrees, minutes, seconds. Actually, I want output should be in a single text box with symbols of degrees, minutes and seconds. Please help me.
Printable View
Hello Friends,
I'm facing problem with a vb program, which will convert decimal degrees in degrees, minutes, seconds. Actually, I want output should be in a single text box with symbols of degrees, minutes and seconds. Please help me.
Does this link help? http://cpearson.com/excel/LatLong.aspx
Take a look here
http://support.microsoft.com/kb/213449, the function "Convert_Degree" is the one you need. The article is for VBA but the code is simple VB.
Another variation:
Or just:Code:Private Function FmtDegMinSec(ByVal Degrees As Single) As String
Dim lngFormat As Long
lngFormat = Int(Degrees) * 10000
lngFormat = lngFormat + Int(Degrees * 60 Mod 60) * 100
lngFormat = lngFormat + Int(Degrees * 3600 Mod 60)
FmtDegMinSec = Format$(lngFormat, "#0° 00' 00\""")
End Function
Code:Private Function FmtDegMinSec(ByVal Degrees As Single) As String
FmtDegMinSec = Format$(Int(Degrees) * 10000 _
+ Int(Degrees * 60 Mod 60) * 100 _
+ Int(Degrees * 3600 Mod 60), _
"#0° 00' 00\""")
End Function
Thanks dear. It will be very helpful for me.
* dilettante's function FmtDegMinSec() has rounding down error with Int()
* Function Convert_Degree() from http://support.microsoft.com/kb/213449 gives wrong format in some cases.
* This is my own function:Code:Function Convert_Degree(Decimal_Deg) As Variant
With Application
'Set degree to Integer of Argument Passed
Degrees = Int(Decimal_Deg)
'Set minutes to 60 times the number to the right
'of the decimal for the variable Decimal_Deg
Minutes = (Decimal_Deg - Degrees) * 60
'Set seconds to 60 times the number to the right of the
'decimal for the variable Minute
Seconds = Format(((Minutes - Int(Minutes)) * 60), "0")
'Returns the Result of degree conversion
'(for example, 10.46 = 10~ 27 ' 36")
Convert_Degree = " " & Degrees & "° " & Int(Minutes) & "' " _
& Seconds + Chr(34)
End With
End Function
Code:Function FormatDMS(ByVal Degs As Double) As String
Degs = Int(Degs * 3600 + 0.5) / 3600 '-- rounding to second
FormatDMS = Int(Degs) & Format(Degs / 24, "°nn'ss\""")
End Function
Code:Sub Test()
Dim d As Double
d = 134.9998
Debug.Print "Convert_Degree("; d; ") = "; Convert_Degree(d)
Debug.Print " FmtDegMinSec("; d; ") = "; FmtDegMinSec(d)
Debug.Print " FormatDMS("; d; ") = "; FormatDMS(d)
d = 134.9999
Debug.Print "Convert_Degree("; d; ") = "; Convert_Degree(d)
Debug.Print " FmtDegMinSec("; d; ") = "; FmtDegMinSec(d)
Debug.Print " FormatDMS("; d; ") = "; FormatDMS(d)
End Sub
Convert_Degree( 134.9998 ) = 134° 59' 59"
FmtDegMinSec( 134.9998 ) = 134° 00' 59"
FormatDMS( 134.9998 ) = 134°59'59"
Convert_Degree( 134.9999 ) = 134° 59' 60"
FmtDegMinSec( 134.9999 ) = 134° 00' 00"
FormatDMS( 134.9999 ) = 135°00'00"
Nice catch and nice solution.
anhn you are in particular AWESOME !Quote:
Originally Posted by anhn
Nice job!
Greetings Dav
anhn's code is elegant, but there is a problem in it, also. Invoke it again, but supplying negative values of those magnitudes.
To handle negative values (e.g., latitude in the southern hemisphere, longitude in the western hemisphere) while still doing the simple rounding, the first steps could be to extract the sign of the parameter, and then work with the absolute value of the parameter. The Sgn and Abs functions are obvious choices there. After the basic formatted result string is built, then apply a leading negative sign as desired. (I.e., you can choose to report negative values that round to zero with a leading minus sign, as the NWS does with temperature on some web pages, or without a leading minus sign, as most people expect with zero values.)Code:FormatDMS(-134.9998 ) = -135°59'59"
FormatDMS(-134.9999 ) = -135°00'00"
Consider the following. It's more verbose than it needs to be, but that may help someone to understand. And it shows some options the function could offer.
Code:Private Function FormatToDegMinSec(ByVal Degrees As Double _
, Optional ByVal FormatForMinutes As String = "00" _
, Optional ByVal FormatForSeconds As String = "00" _
) As String
Dim dstrReturnValue As String
Dim din2NumericSign As Integer
Dim ddblWorkValue As Double
Dim ddblHalfOfPrecision As Double
'---- Capture the sign of the parameter.
din2NumericSign = Sgn(Degrees)
'---- Round the absolute value of the parameter to the second.
ddblWorkValue = Abs(Degrees)
ddblHalfOfPrecision = 0.5
ddblWorkValue = Int(ddblWorkValue * 3600 + ddblHalfOfPrecision)
' -- If the result is zero...
'If ddblWorkValue = 0 Then
' You could choose to reassign:
' din2NumericSign = 0
' I choose not to do that.
'End If
'---- Do the formatting.
dstrReturnValue = CStr(Int(ddblWorkValue / 3600)) & "°"
ddblWorkValue = ddblWorkValue Mod 3600
dstrReturnValue = dstrReturnValue _
& Format$(Int(ddblWorkValue / 60), FormatForMinutes) & "'"
ddblWorkValue = ddblWorkValue Mod 60
dstrReturnValue = dstrReturnValue _
& Format$(ddblWorkValue, FormatForSeconds) & """"
' -- Conditionally apply a leading minus sign.
If din2NumericSign = -1 Then
dstrReturnValue = "-" & dstrReturnValue
End If
'---- Return.
FormatToDegMinSec = dstrReturnValue
Exit Function
End Function
FWIW (and to maintain the spirit of a "one-liner-function"), here's a little fix for FormatDMS:
The difference to your FormatToDegMinSec-routine is, that yours is about factor 2 slower - and it will hand out negativeCode:Private Function FormatDMS(ByVal Degs As Double) As String
FormatDMS = Mid$("-", Sgn(Degs * 3600 \ 1) + 2) & Abs(Degs) * 3600 \ 3600 & Format$(Degs / 24, "°nn'ss\""")
End Function
signed (-0°00'00") Values for the input-range-interval [-0.00013 to 0) ... whilst the above (fixed) FormatDMS doesn't.
HTH
Olaf