Как да конвертирате UTM координати в стойности за географска ширина и дължина чрез Excel VBA

С UTM конвертора можете лесно да преобразувате UTM координатите в стойности за географска ширина и дължина. Универсалната напречна Меркаторова координата (UTM) се състои от номер на зона, изток, север и полукълбо (N/S).

Свали сега

Ако искате да започнете да използвате софтуера възможно най-скоро, можете да:

Изтеглете софтуера сега

В противен случай, ако искате да си направите сам, можете да прочетете съдържанието по-долу.

Нека подготвим GUI

Както е показано на изображението, оставете горните 4 реда на Excel листа за съхранение на данни за картата, зоната и полукълбото. Тези 3 стойности ще бъдат използвани за всички редове в Excel листа. На ред 5, започвайки от колона A, добавете ги като заглавки.

1. DLS_KEY
2. RM
3. ИСТИНСКИ
4. СЕВЕР
5. ГЕОГРАФСКА ШИРИНА
6. ДЪЛЖИНА

Стойността в колони A до колона D се въвежда, а изходът, т.е. географска ширина и дължина, се показва в колони E и F

Нека го направим функционален

Копирайте скрипта в нов модул и прикачете макроса към бутона на листа. Моля, уверете се, че вашето устройство има Internet Explorer. Без IE този скрипт няма да работи.

Да го тестваме

Когато стартирате макроса, можете лесно да проследите състоянието от лентата на състоянието на вашето приложение Excel. Тъй като ръчно сме предизвикали известна пауза между всяко преобразуване, макросът ще отнеме време, за да преобразува всичките ви UTM координати в стойности за ширина и дължина. Когато всички записи са обработени, можете да видите изскачащо съобщение на екрана. Ако макросът не може да записва данни в листове, това може да се дължи на повреда във вашия Excel файл. Поправете повреден Excel файл и стартирайте скрипта отново.

скрипт:

Sub UTM_Converter()
    
' Place all your declarations here
    Dim i As Long
    Dim browobject As Object
    Dim obj1 As Object
    Dim obj2 As Object
    
    Set browobject = CreateObject("InternetExplorer.Application")
    
    browobject.Visible = False
    
'Process each row in the excle till the macro meets the last used row
    For r = 6 To 9
        
' Navigate to the URL to process data
        browobject.navigate "http://www.rcn.montana.edu/resources/converter.aspx"
        
' Inform Users about the status
        Application.StatusBar = "Macro is converting data. Please wait... Now at Row : " & r & " /// Total Rows : " & Sheets("UTM to LAT LON").Range("C" & Rows.Count).End(xlUp).Row
        
' As this is dynamic, we have to wait for the browobject to process input and generate output
        Do While browobject.Busy
            Application.Wait DateAdd("s", 1, Now)
        Loop
        Application.Wait (Now() + TimeValue("00:00:02"))
        
'Lets populate the form
        browobject.document.getElementById("mapDatum").Value = "1"
        browobject.document.getElementById("utmZone").Value = "14"
        browobject.document.getElementById("utmHemi").Value = "N"
'utmEasting
        browobject.document.getElementById("utmEasting").Value = Sheets("UTM to LAT LON").Range("C" & r).Value
'utmNorthing
        browobject.document.getElementById("utmNorthing").Value = Sheets("UTM to LAT LON").Range("D" & r).Value
        
        Set obj2 = browobject.document.getElementsByTagName("input")
        v_length = 0
        While v_length < obj2.Length
            If obj2(v_length).Value = "Convert Standard UTM" Then
                GoTo comehere
            End If
            v_length = v_length + 1
        Wend
        
        comehere:
        obj2(v_length).Click
' Wait while browobject loading...
        Do While browobject.Busy
            Application.Wait DateAdd("s", 1, Now)
        Loop
        Application.Wait (Now() + TimeValue("00:00:02"))
        
'Show converted data on the sheet
        Sheets("UTM to LAT LON").Range("F" & r).Value = browobject.document.getElementById("decimalLongitude").Value
        Sheets("UTM to LAT LON").Range("E" & r).Value = browobject.document.getElementById("decimalLatitude").Value
        
    Next r
        
' Show browobject
    browobject.Visible = False
    browobject.Quit
        
' Clean up
    Set browobject = Nothing
    Set obj1 = Nothing
    Set obj2 = Nothing
        
    Application.StatusBar = ""
'Inform User that entire process was completed
    MsgBox "Converted !", vbInformation, "UTM to LAT LON converter v1.0"
End Sub

Въведение на автора:

Ник Випонд е експерт по възстановяване на данни в DataNumen, Inc., която е световен лидер в технологиите за възстановяване на данни, включително файл за ремонт на док и перспектива за възстановяване на софтуерни продукти. За повече информация посетете WWW.datanumen.com