Τρόπος μετατροπής συντεταγμένων UTM σε τιμές γεωγραφικού πλάτους και μήκους μέσω του Excel VBA

Με τον μετατροπέα UTM μπορείτε εύκολα να μετατρέψετε τις συντεταγμένες UTM σε τιμές γεωγραφικού πλάτους και μήκους. Μια συντεταγμένη Universal Transverse Mercator (UTM) αποτελείται από έναν αριθμό ζώνης, έναν ανατολικό, έναν βορρά και ένα ημισφαίριο (N / S).

Κατεβάστε το Δωρεάν Τώρα

Αν θέλετε να ξεκινήσετε να χρησιμοποιείτε το λογισμικό το συντομότερο δυνατό, τότε μπορείτε:

Κάντε λήψη του λογισμικού τώρα

Διαφορετικά, αν θέλετε να κάνετε DIY, μπορείτε να διαβάσετε τα παρακάτω περιεχόμενα.

Ας προετοιμάσουμε το GUI

Όπως φαίνεται στην εικόνα, αφήστε τις 4 πρώτες σειρές του φύλλου excel για να αποθηκεύσετε τα Δεδομένα Χάρτη, Ζώνη και Ημισφαίριο. Αυτές οι 3 τιμές θα χρησιμοποιηθούν για όλες τις σειρές του φύλλου Excel. Στη Σειρά 5, ξεκινώντας από τη Στήλη Α, προσθέστε τις ως κεφαλίδες.

1. DLS_KEY
2. RM
3. ΓΡΗΓΟΡΑ
4. ΒΟΡΕΙΑ
5. LATITUDE
6. ΓΕΩΓΡΑΦΙΚΟ ΜΗΚΟΣ

Η τιμή στις στήλες Α έως τη στήλη D είναι η είσοδος και η έξοδος, δηλαδή, το πλάτος και το μήκος εμφανίζονται στις στήλες E και F

Ας το κάνουμε λειτουργικό

Αντιγράψτε το σενάριο σε μια νέα ενότητα και επισυνάψτε τη μακροεντολή στο κουμπί του Φύλλου. Βεβαιωθείτε ότι ο υπολογιστής σας διαθέτει Internet Explorer. Χωρίς IE αυτό το σενάριο δεν θα λειτουργήσει.

Ας το δοκιμάσουμε

Όταν εκτελείτε τη μακροεντολή, μπορείτε εύκολα να παρακολουθείτε την κατάσταση από τη γραμμή κατάστασης της εφαρμογής Excel. Καθώς έχουμε προκαλέσει χειροκίνητα κάποια παύση μεταξύ κάθε μετατροπής, η μακροεντολή θα χρειαστεί χρόνο για τη μετατροπή όλων των συντεταγμένων UTM σε τιμές Lat και Long. Όταν γίνεται επεξεργασία όλων των εγγραφών, μπορείτε να δείτε ένα αναδυόμενο μήνυμα στην οθόνη. Εάν η μακροεντολή δεν είναι σε θέση να αποθηκεύσει δεδομένα σε φύλλα, αυτό μπορεί να οφείλεται σε καταστροφή στο αρχείο Excel. Επιδιόρθωση κατεστραμμένου αρχείου Excel και εκτελέστε ξανά το σενάριο.

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

Εισαγωγή συγγραφέα:

Ο Nick Vipond είναι ειδικός στην ανάκτηση δεδομένων στο DataNumen, Inc., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων επιδιόρθωση αρχείου doc και προϊόντα λογισμικού αποκατάστασης προοπτικών. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com