Ako previesť súradnice UTM na hodnoty zemepisnej šírky a dĺžky pomocou programu Excel VBA

Zdieľať teraz:

S prevodníkom UTM môžete ľahko prevádzať súradnice UTM na hodnoty zemepisnej šírky a dĺžky. Súradnica Universal Transverse Mercator (UTM) je tvorená číslom zóny, východom, severom a pologuľou (N / S).

stiahnuť

Ak chcete začať používať softvér čo najskôr, môžete:

Stiahnite si softvér teraz

V opačnom prípade si môžete prečítať obsah uvedený nižšie.

Poďme pripraviť GUI

Ako je znázornené na obrázku, ponechajte horné 4 riadky excelovského hárku na uloženie údajov o mape, zóny a pologule. Tieto 3 hodnoty sa použijú pre všetky riadky v excelovskom hárku. V riadku 5, počnúc stĺpcom A, ich pridajte ako záhlavia.

  1. DLS_KEY
  2. RM
  3. VÝCHOD
  4. SEVERNÉ
  5. LATITUDE
  6. DLHÁ ŠTÚDIA

Hodnota na stĺpcoch A až stĺpec D je vstupná a výstup, tj. Zemepisná šírka a dĺžka sa zobrazí na stĺpcoch E a FPripravte GUI

Nech je to funkčné

Skopírujte skript do nového modulu a pripojte makro k tlačidlu na hárku. Uistite sa, že vaše zariadenie má internetový prehliadač. Bez IE tento skript nebude fungovať.

Poďme to vyskúšať

Po spustení makra môžete ľahko sledovať stav na stavovom riadku aplikácie Excel. Pretože sme medzi každou konverziou manuálne vyvolali určitú pauzu, makru bude nejaký čas trvať, kým prevedie všetky vaše súradnice UTM na hodnoty Lat a Long. Po spracovaní všetkých záznamov sa na obrazovke zobrazí vyskakovacie okno. Ak makro nedokáže uložiť údaje na hárky, môže to byť spôsobené poškodením súboru Excel. Opravte poškodený súbor programu Excel a spustite skript znova.Sledujte stav na stavovom riadku aplikácie Excel

Vyskakovacia správa na obrazovke

scenár:

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

Úvod autora:

Nick Vipond je expert na obnovu dát v DataNumen, Inc., ktorá je svetovým lídrom v oblasti technológií obnovy dát, vrátane opraviť dokumentačný súbor a výhľadové softvérové ​​produkty na obnovenie. Pre viac informácií navštívte www.datanumen. S

Zdieľať teraz:

Komentáre sú uzavreté.