Excel VBA orqali UTM koordinatalarini kenglik va uzunlik qiymatlariga qanday aylantirish mumkin

UTM konvertori yordamida siz osongina UTM koordinatalarini kenglik va uzunlik qiymatlariga aylantirishingiz mumkin. Universal Transvers Mercator (UTM) koordinatasi zona raqami, sharq, shimoliy va yarim shardan (N/S) iborat.

Hozir yuklab olmoq

Agar siz dasturiy ta'minotdan iloji boricha tezroq foydalanishni boshlamoqchi bo'lsangiz, unda quyidagilarni qilishingiz mumkin:

Dasturiy ta'minotni hozir yuklab oling

Aks holda, agar siz DIY qilishni istasangiz, quyidagi tarkibni o'qishingiz mumkin.

GUI ni tayyorlaylik

Rasmda ko'rsatilganidek, Excel varag'ining yuqori 4 qatorini Xarita ma'lumotlari, Zona va Yarim sharni saqlash uchun qoldiring. Ushbu 3 ta qiymat Excel varag'idagi barcha qatorlar uchun ishlatiladi. 5-qatorda, A ustunidan boshlab, ularni sarlavha sifatida qo'shing.

1. DLS_KEY
2. RM
3. EASTING
4. Shimol
5. SAVOL
6. BOYLIK

A dan D ustunlaridagi qiymat kiritiladi va chiqish, ya'ni E va F ustunlarida kenglik va uzunlik ko'rsatiladi.

Keling, uni funksional holga keltiraylik

Skriptni yangi modulga nusxalash va makrosni varaqdagi tugmachaga biriktirish. Iltimos, kompyuteringizda Internet Explorer borligiga ishonch hosil qiling. IEsiz bu skript ishlamaydi.

Keling, sinab ko'raylik

Makrosni ishga tushirganingizda, Excel ilovasining holat satridan holatni osongina kuzatishingiz mumkin. Har bir konvertatsiya oʻrtasida qoʻlda biroz pauza qoʻyganimiz sababli, makro barcha UTM koordinatalaringizni Lat va Long qiymatlariga aylantirish uchun vaqt oladi. Barcha yozuvlar qayta ishlangach, ekranda qalqib chiquvchi xabarni ko'rishingiz mumkin. Agar so'l varaqlardagi ma'lumotlarni saqlay olmasa, bu sizning Excel faylingizdagi buzilish tufayli bo'lishi mumkin. Buzilgan Excel faylini tuzatish va skriptni qayta ishga tushiring.

Ssenariy:

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

Muallif kirish:

Nik Vipond - ma'lumotlarni qayta tiklash bo'yicha mutaxassis DataNumenMa'lumotlarni qayta tiklash texnologiyalari bo'yicha jahon yetakchisi bo'lgan , Inc doc faylni tuzatish va istiqbolni tiklash dasturiy mahsulotlar. Qo'shimcha ma'lumot olish uchun tashrif buyuring www.datanumen.com