VB form to convert Decimal Degrees to DMS

[sagar233]

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.

[LaVolpe]

Does this link help? http://cpearson.com/excel/LatLong.aspx

[kostasc]

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.

[dilettante]

Another variation:

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

Or just:

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

[sagar233]

Thanks dear. It will be very helpful for me.

[anhn]

* 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.

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

* This is my own function:

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

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"

[dilettante]

Nice catch and nice solution.

[rumcum]

* 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.

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

* This is my own function:

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

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"

anhn you are in particular AWESOME !

Nice job!

Greetings Dav

[NPlainsFarmBoy]

anhn's code is elegant, but there is a problem in it, also. Invoke it again, but supplying negative values of those magnitudes.

     FormatDMS(-134.9998 ) = -135°59'59"
     FormatDMS(-134.9999 ) = -135°00'00"

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.)

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.

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

[Schmidt]

FWIW (and to maintain the spirit of a "one-liner-function"), here's a little fix for FormatDMS:

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

The difference to your FormatToDegMinSec-routine is, that yours is about factor 2 slower - and it will hand out negative
signed (-0°00'00") Values for the input-range-interval [-0.00013 to 0) ... whilst the above (fixed) FormatDMS doesn't.

HTH

Olaf