Naudodami UTM keitiklį galite lengvai konvertuoti UTM koordinates į platumos ir ilgumos reikšmes. Universalioji skersinė Merkatoriaus (UTM) koordinatė sudaryta iš zonos numerio, rytų, šiaurės ir pusrutulio (N/S).
Atsisiųsti dabar
Jei norite kuo greičiau pradėti naudoti programinę įrangą, galite:
Atsisiųskite programinę įrangą dabar
Kitu atveju, jei norite pasidaryk pats, galite perskaityti toliau pateiktą turinį.
Paruoškime GUI
Kaip parodyta paveikslėlyje, viršutines 4 „Excel“ lapo eilutes palikite žemėlapio duomenų, zonos ir pusrutulio reikšmėms įrašyti. Šios 3 reikšmės bus naudojamos visose „Excel“ lapo eilutėse. 5 eilutėje, pradedant nuo A stulpelio, pridėkite jas kaip antraštes.
- DLS_KEY
- RM
- RYTAS
- ŠIAURĖ
- LATITUDE
- ILGIAI
Įvedama vertė A–D stulpeliuose, o išvestis, ty platuma ir ilguma, rodomos E ir F stulpeliuose
Padarykime jį funkcionalų
Nukopijuokite scenarijų į naują modulį ir pridėkite makrokomandą prie lapo mygtuko. Įsitikinkite, kad jūsų kompiuteryje yra „Internet Explorer“. Be IE šis scenarijus neveiks.
Išbandykime
Vykdydami makrokomandą galite lengvai stebėti būseną „Excel“ programos būsenos juostoje. Kadangi tarp kiekvienos konversijos neautomatiniu būdu padarėme tam tikrą pauzę, makrokomandai prireiks laiko, kad visos jūsų UTM koordinatės būtų konvertuojamos į platumą ir ilgumą. Kai visi įrašai bus apdoroti, ekrane pamatysite iššokantįjį pranešimą. Jei makrokomandos negalima išsaugoti duomenų lapuose, tai gali būti dėl sugadinto Excel failo. Pataisykite sugadintą Excel failą ir paleiskite scenarijų dar kartą.
scenarijus:
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
Autoriaus įvadas:
Nickas Vipondas yra duomenų atkūrimo ekspertas DataNumen, Inc., kuri yra pasaulyje duomenų atkūrimo technologijų lyderė, įskaitant taisyti doc failą ir Outlook atkūrimo programinės įrangos produktai. Norėdami gauti daugiau informacijos, apsilankykite WWW.datanumen.com