Як перетворити координати UTM у значення широти та довготи за допомогою програми Excel VBA

За допомогою конвертера UTM ви можете легко перетворити координати UTM у значення широти та довготи. Універсальна поперечна координата Меркатора (UTM) складається з номера зони, сходу, півночі та півкулі (N / S).

Завантажити зараз

Якщо ви хочете почати користуватися програмним забезпеченням якомога швидше, ви можете:

Завантажте програмне забезпечення зараз

В іншому випадку, якщо ви хочете зробити самостійно, ви можете прочитати вміст нижче.

Давайте підготуємо графічний інтерфейс

Як показано на зображенні, залиште верхні 4 рядки аркуша Excel для зберігання даних карти, зони та півкулі. Ці 3 значення будуть використовуватися для всіх рядків аркуша Excel. У рядку 5, починаючи зі стовпця A, додайте їх як заголовки.

1. DLS_KEY
2. RM
3. СХІД
4. ПІВНІЧНО
5. LATITUDE
6. ВДОЛОГО

Значення для стовпців від A до стовпця D є вхідним та вихідним значенням, тобто широта та довгота відображаються у стовпцях E та F

Зробимо його функціональним

Скопіюйте сценарій у новий модуль і прикріпіть макрос до кнопки на аркуші. Переконайтеся, що на вашому комп'ютері встановлено Internet Explorer. Без IE цей сценарій не буде працювати.

Давайте перевіримо

Під час запуску макросу ви можете легко відстежувати стан із рядка стану програми Excel. Оскільки ми вручну викликали деяку паузу між кожним перетворенням, макрос займе час, щоб перетворити всі ваші координати UTM у значення Lat і Long. Коли всі записи оброблені, на екрані з’явиться спливаюче повідомлення. Якщо макрос не може зберегти дані на аркушах, можливо, це пов’язано з пошкодженням у вашому файлі 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