Как преобразовать координаты UTM в значения широты и долготы через Excel VBA

С конвертером UTM вы можете легко конвертировать координаты UTM в значения широты и долготы. Координата Universal Transverse Mercator (UTM) состоит из номера зоны, восточного и северного направлений и полушария (N/S).

Скачать сейчас

Если вы хотите сtart использовать программное обеспечение как можно скорее, то вы можете:

Загрузите программное обеспечение сейчас

В противном случае, если вы хотите сделать своими руками, вы можете прочитать содержимое ниже.

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

Как показано на изображении, оставьте 4 верхние строки листа Excel для хранения данных карты, зоны и полушария. Эти 3 значения будут использоваться для всех строк на листе Excel. В ряду 5, сtarиз столбца 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., которая является мировым лидером в области технологий восстановления данных, включая восстановить файл документа и программные продукты для восстановления Outlook. Для получения дополнительной информации посетите www.datanumen.com