Cara Mengonversi Koordinat UTM menjadi nilai Lintang dan Bujur melalui Excel VBA

Bagikan sekarang:

Dengan konverter UTM Anda dapat dengan mudah mengubah koordinat UTM menjadi nilai Lintang dan Bujur. Koordinat Universal Transverse Mercator (UTM) terdiri dari nomor zona, timur, utara, dan belahan bumi (N / S).

Unduh Sekarang

Jika Anda ingin start untuk menggunakan perangkat lunak secepat mungkin, maka Anda dapat:

Unduh Perangkat Lunak Sekarang

Kalau tidak, kalau mau DIY bisa baca isinya di bawah ini.

Mari Siapkan GUI

Seperti yang ditunjukkan pada gambar, tinggalkan 4 baris teratas dari lembar excel untuk menahan Map Datum, Zone dan Hemisphere. 3 nilai ini akan digunakan untuk semua baris di lembar Excel. Di Baris 5, starting dari Kolom A, tambahkan ini sebagai tajuk

  1. DLS_KEY
  2. RM
  3. ARAH TIMUR
  4. UTARA
  5. LINTANG
  6. GARIS BUJUR

Nilai pada Kolom A sampai Kolom D adalah input dan output yaitu, Latitude dan Longitude ditampilkan pada Kolom E dan FSiapkan GUI

Mari kita membuatnya berfungsi

Salin skrip ke modul baru dan lampirkan makro ke tombol di Lembar. Harap pastikan bahwa mesin Anda memiliki penjelajah Internet. Tanpa IE script ini tidak akan berfungsi.

Mari kita uji

Saat Anda menjalankan makro, Anda bisa dengan mudah melacak status dari bilah status aplikasi Excel Anda. Karena kami telah membuat jeda secara manual di antara setiap konversi, makro akan meluangkan waktu untuk mengubah semua koordinat UTM Anda menjadi nilai Lintang dan Bujur. Saat semua catatan diproses, Anda dapat melihat pesan Pop-Up di layar. Jika makro tidak dapat menyimpan data di lembar, itu mungkin karena kerusakan di file Excel Anda. Perbaiki file Excel yang rusak dan jalankan skrip lagi.Lacak Status Dari Bilah Status Aplikasi Excel Anda

Pesan Pop-Up Di Layar

Skrip:

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

Pengantar Penulis:

Nick Vipond adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk memperbaiki file doc dan produk perangkat lunak pemulihan prospek. Untuk informasi lebih lanjut kunjungi www.datanumen.com

Bagikan sekarang:

Komentar ditutup.