Kako pretvoriti UTM koordinate u vrijednosti zemljopisne širine i dužine putem Excel VBA

Pomoću UTM pretvarača možete jednostavno pretvoriti UTM koordinate u vrijednosti zemljopisne širine i dužine. Univerzalna transverzalna Mercatorova (UTM) koordinata sastoji se od broja zone, istočne, sjeverne i hemisfere (N/S).

Preuzmite sada

Ako želite što prije početi koristiti softver, možete:

Preuzmite softver sada

Inače, ako želite DIY, možete pročitati sadržaj u nastavku.

Pripremimo GUI

Kao što je prikazano na slici, ostavite gornja 4 retka Excel tablice za podatke o datumu karte, zoni i hemisferi. Ove 3 vrijednosti će se koristiti za sve retke u Excel tablici. U retku 5, počevši od stupca A, dodajte ih kao zaglavlja.

1. DLS_KEY
2. RM
3. PLOVIDBA NA ISTOK
4. NIŠTA
5. LATITUDE
6. DUŽINA

Vrijednost u stupcima od A do stupaca D je ulaz, a izlaz, tj. zemljopisna širina i dužina, prikazuje se u stupcima E i F

Učinimo ga funkcionalnim

Kopirajte skriptu u novi modul i priložite makronaredbu gumbu na listu. Provjerite ima li vaše računalo Internet Explorer. Bez IE ova skripta neće raditi.

Isprobajmo ga

Kada pokrenete makronaredbu, možete jednostavno pratiti status sa statusne trake svoje Excel aplikacije. Budući da smo ručno inducirali stanku između svake konverzije, makronaredba će trebati vremena da pretvori sve vaše UTM koordinate u vrijednosti širine i duljine. Kada su svi zapisi obrađeni, na zaslonu možete vidjeti skočnu poruku. Ako makronaredba ne može spremiti podatke na listove, to može biti zbog oštećenja u vašoj Excel datoteci. Popravite oštećenu Excel datoteku i ponovno pokrenite skriptu.

skripta:

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

Uvod za autora:

Nick Vipond je stručnjak za oporavak podataka u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući popraviti doc datoteku i softverski proizvodi za oporavak Outlooka. Za više informacija posjetite www.datanumen.com