Option Explicit 
 
Sub DegDMS_Test() 
     '
     '       Demonstration:  interacts with use to demonstrate use degree <> Deg/Min/Sec
     '                       conversion functions
     '
    Dim Angle   As Single 
    Dim Ans     As String 
    Dim Deg     As Integer 
    Dim I       As Integer 
    Dim IRC     As Integer 
    Dim Min     As Integer 
    Dim Sec     As Integer 
    Dim Title   As String 
     
    Title = "Test of decimal <> Deg/Min/Sec conversions" 
    On Error GoTo ErrorHandling 
GetInitial: 
    Ans = InputBox("enter test #:" & vbCrLf & _ 
    "1  convert degs in decimal to degs in deg/min/sec" & vbCrLf & _ 
    "2  convert degs in deg/min/sec to degs in decimal" & vbCrLf & vbCrLf & _ 
    "[enter nothing or click on Cancel to quit]", Title) 
    If Ans = "" Then Exit Sub 
    I = Ans 
    Select Case I 
    Case Is = 1 
        GetCase1:   Ans = InputBox("angle in decimal form, e.g., 89.45", _ 
        "Demo of Dec2DegMinSec") 
        If Ans = "" Then GoTo GetInitial 
        Angle = Ans 
        Call Dec2DegMinSec(Angle, Deg, Min, Sec) 
        MsgBox "input angle in decimal form = " & Angle & vbCrLf & _ 
        "converted to deg / min / sec = " & Deg & " / " & Min & " / " & Sec, _ 
        vbInformation, Title 
        GoTo GetCase1 
    Case Is = 2 
        GetCase2:   Ans = InputBox("enter angle in deg/min/sec format", _ 
        "Demo of DegMinSec2Dec") 
        If Ans = "" Then GoTo GetInitial 
        IRC = 0 
        Call DecodeDMS(1, Ans, Deg, Min, Sec, IRC) 
        If IRC <> 1 Then 
            Call DecodeDMS(2, Ans, Deg, Min, Sec, IRC) 
            GoTo GetCase2 
        End If 
        Angle = DegMinSec2Dec(Deg, Min, Sec) 
        MsgBox "input angle in deg / min / sec = " & Deg & " / " & Min & " / " & Sec & vbCrLf & _ 
        "converted to decimal form = " & Format(Angle, "##0.###"), vbInformation, _ 
        Title 
        GoTo GetCase2 
    End Select 
    GoTo GetInitial 
ErrorHandling: 
    MsgBox "error encountered during processing of input.  Likely" & vbCrLf & _ 
    "cause is improper format of input", vbCritical + vbOKOnly, Title 
     
End Sub 
 
Sub Dec2DegMinSec(AngleinDegs, Deg, Min, Sec) 
     '
     '       Function   converts an angle in degrees to its corresponding
     '                   Deg, Min, Sec
     '       Passed Values
     '           AngleinDegs [in, real*]     Angle to be converted (in degrees)
     '           Deg         [out, numeric**]
     '           Min         [out, numeric**]
     '           Sec         [out, numeric**]
     '       *   real means single or double
     '       **  numeric means Integer, Double, Single or Double
     '
    Dim X As Single, Xmin As Single 
    X = Abs(AngleinDegs) 
    Deg = Int(X) 
    Min = Int(60 * (X - Deg) Mod 60) 
    If Min < 0 Then 
        Deg = Deg - 1 
        Min = Min + 60 
    End If 
    Xmin = Min 
    Sec = Int(3600 * (X - Deg - Xmin / 60) Mod 60) 
    If Sec < 0 Then 
        Min = Min - 1 
        Sec = Sec + 60 
    End If 
    If AngleinDegs < 0 Then 
        Deg = -Deg 
        Min = -Min 
        Sec = -Sec 
    End If 
     
End Sub 
 
Function DegMinSec2Dec(Deg, Min, Sec) As Single 
     '
     '       Function   converts an angle in Deg,Min,Sec form to its corresponding
     '                   decimal form
     '       Passed Values
     '           Deg         [in, numeric**]
     '           Min         [in, numeric**]
     '           Sec         [in, numeric**]
     '       *   real means single or double
     '       **  numeric means Integer, Double, Single or Double
     '
    DegMinSec2Dec = Deg + Min / 60 + Sec / 3600 
     
End Function 
 
Sub DecodeDMS(OpCode, Text As String, Deg, Min, Sec, IRC) 
     '
     '       Function    decodes a text string containing Deg/Min/Sec info into
     '                   individual Deg, Min, and Sec values
     '       Passed Values
     '           OpCode  [in, integer/long] defines what function procedure is to perform
     '               Opcode = 1  normal decode
     '               Opcode = 2  display "bad text" error message
     '                           by separating decode from error display, calling proc
     '                               has control over what happens if "text is bad"
     '           Text    [in, string] character string to be decoded
     '           Deg     [out, numeric**]
     '           Min     [out, numeric**]
     '           Sec     [out, numeric**]
     '           IRC     [out, numeric**] return code:
     '               IRC = 1 ==> OK
     '               IRC = 0 ==> decode was not completed
     '       **  numeric means Integer, Double, Single or Double
     '
     '
    Dim I1 As Integer 
    Dim I2 As Integer 
     
    Select Case OpCode 
    Case Is = 1 
        IRC = 0 
        I1 = InStr(1, Text, "/") 
        If I1 = 0 Then Exit Sub 
        If I1 = 1 Then 
            Deg = 0 
        Else 
            Deg = Mid(Text, 1, I1 - 1) 
        End If 
        I1 = I1 + 1 
        I2 = InStr(I1, Text, "/") 
        If I2 = 0 Then Exit Sub 
        If I2 = I1 Then 
            Min = 0 
        Else 
            Min = Mid(Text, I1, I2 - I1) 
        End If 
        If Abs(Min) > 60 Then Exit Sub 
        If Len(Text) = I2 Then 
            Sec = 0 
        Else 
            I2 = I2 + 1 
            Sec = Mid(Text, I2, Len(Text) - I2 + 1) 
        End If 
        If Abs(Sec) > 60 Then Exit Sub 
        IRC = 1 
    Case Is = 2 
        MsgBox Text & " is not acceptable.  Possible problems:" & vbCrLf & _ 
        "    not in the format Deg/Min/Sec" & vbCrLf & _ 
        "    min or sec value is outside range [-60 , 60]" & vbCrLf & vbCrLf & _ 
        "NOTE: the two slash separators are required, but numeric values" & vbCrLf & _ 
        "are not.  Thus:" & vbCrLf & _ 
        "   123// is the same as 123/0/0" & vbCrLf & _ 
        "   /50/ is the same as 0/50/0" & vbCrLf & _ 
        "   //20 is the same as 0/0/20, etc", _ 
        vbCritical & vbOKOnly 
        IRC = -1 
    End Select 
     
End Sub