UTM хөрвүүлэгчийн тусламжтайгаар та UTM координатыг Өргөрөг ба Уртрагийн утга болгон хялбархан хөрвүүлэх боломжтой. Universal Transverse Mercator (UTM) координат нь бүсийн дугаар, зүүн, хойд, бөмбөрцөг (N / S) -ээс бүрдэнэ.
Одоо Татах
Хэрэв та програмыг аль болох хурдан ашиглаж эхлэхийг хүсвэл дараах зүйлсийг хийж болно:
Үгүй бол, хэрэв та DIY хийхийг хүсвэл доорхи агуулгыг уншиж болно.
GUI-г бэлдэцгээе
Зурагт үзүүлсэн шиг, Excel хүснэгтийн дээд 4 мөрийг Газрын зургийн өгөгдлийн тоо, бүс болон хагас бөмбөрцгийг хадгалахаар үлдээнэ үү. Эдгээр 3 утгыг Excel хүснэгтийн бүх мөрүүдэд ашиглана. 5-р мөрөнд, А баганаас эхлэн эдгээрийг толгой болгон нэмнэ үү.
- DLS_KEY
- RM
- Зүүн
- ХОЙШ
- LATITUDE
- ХАЙРТАЙ
А ба D баганын баганын утга нь оролт бөгөөд гаралт, өөрөөр хэлбэл E, F баганад Өргөрөг ба Уртраг харагдана.
Үүнийг функциональ болгоё
Скриптийг шинэ модульд хуулж, макро хуудсыг товчлуур дээр хавсаргана уу. Таны машинд Internet Explorer байгаа эсэхийг шалгана уу. IE-гүй бол энэ скрипт ажиллахгүй.
Үүнийг туршиж үзье
Макро ажиллуулахдаа Excel програмын статус мөрөөс статусыг хялбархан хянах боломжтой. Хөрвүүлэлт бүрийн хоорондох гаралтыг түр зогсоосон тул макро нь таны бүх UTM координатыг Lat ба Long гэсэн утгуудад хөрвүүлэхэд цаг хугацаа шаардагдана. Бүх бичлэгийг боловсруулж дууссаны дараа та дэлгэц дээр гарч ирэх цонхыг харах боломжтой. Хэрэв макро хуудсан дээрх өгөгдлийг хадгалах боломжгүй бол энэ нь таны Excel файл дахь авлигаас үүдэлтэй байж магадгүй юм. Эвдэрсэн Excel файлыг засах скриптийг дахин ажиллуулна уу.
Скрипт:
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
Зохиогчийн танилцуулга:
Ник Випонд бол мэдээлэл сэргээх мэргэжилтэн юм DataNumen, Үүнд мэдээлэл сэргээх технологиор дэлхийд тэргүүлэгч, Inc. doc файлыг засах болон хэтийн төлөвийг сэргээх програм хангамжийн бүтээгдэхүүнүүд. Дэлгэрэнгүй мэдээллийг авна уу WWW.datanumen.com