Si të konvertoni koordinatat UTM në vlerat e gjerësisë dhe gjatësisë përmes Excel VBA

Me konvertuesin UTM mund t'i konvertoni lehtësisht koordinatat UTM në vlerat e gjerësisë dhe gjatësisë. Një koordinatë Universale Transversale Mercator (UTM) përbëhet nga një numër zonash, një lindje, një veri dhe një hemisferë (N/S).

Shkarkojeni Tani

Nëse dëshironi të starpër të përdorur softuerin sa më shpejt të jetë e mundur, atëherë mund të:

Shkarkoni softuerin tani

Përndryshe, nëse dëshironi të bëni DIY, mund të lexoni përmbajtjen më poshtë.

Le të përgatisim GUI-në

Siç tregohet në imazh, lini 4 rreshtat e sipërm të fletës excel për të mbajtur të dhënat e Hartës, Zonën dhe Hemisferën. Këto 3 vlera do të përdoren për të gjitha rreshtat në fletën Excel. Në rreshtin 5, starting nga Kolona A, shtoni këto si kokë

1. DLS_KEY
2. RM
3. PASTRIMI
4. VERIUJ
5. LATITUDE
6. GJATZIMI

Vlera në kolonat A deri në kolonën D është e hyrjes dhe dalja dmth. Gjerësia dhe gjatësia shfaqen në kolonat E dhe F

Le ta bëjmë atë funksional

Kopjoni skriptin në një modul të ri dhe bashkëngjitni makro në butonin në Fletë. Ju lutemi sigurohuni që pajisja juaj të ketë Internet Explorer. Pa IE ky skenar nuk do të funksionojë.

Le ta testojmë

Kur ekzekutoni makro, mund ta gjurmoni lehtësisht statusin nga shiriti i statusit të aplikacionit tuaj Excel. Meqenëse ne kemi nxitur manualisht një pauzë midis çdo konvertimi, makro do të marrë kohë për të kthyer të gjitha koordinatat tuaja UTM në vlera Lat dhe Long. Kur të gjitha regjistrimet përpunohen, mund të shihni një mesazh Pop-Up në ekran. Nëse makro nuk është në gjendje të ruajë të dhëna në fletë, mund të jetë për shkak të korrupsionit në skedarin tuaj Excel. Rregulloni skedarin e korruptuar Excel dhe ekzekutoni përsëri skenarin.

script:

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

Hyrje e autorit:

Nick Vipond është një ekspert i rikuperimit të të dhënave në DataNumen, Inc., e cila është lider botëror në teknologjitë e rikuperimit të të dhënave, duke përfshirë riparimi i skedarit të dokumentit dhe produkte softuerike për rikuperimin e opinionit. Për më shumë informacion vizitoni www.datanumen.com