So konvertieren Sie UTM-Koordinaten über Excel VBA in Breiten- und Längengrade

Mit dem UTM-Konverter können Sie UTM-Koordinaten einfach in Breiten- und Längengrade konvertieren. Eine UTM-Koordinate (Universal Transverse Mercator) besteht aus einer Zonennummer, einer Ost-, einer Nord- und einer Halbkugel (N / S).

Laden Sie den WHS jetzt kostenlos herunter

Wenn du s willsttarUm die Software so schnell wie möglich zu verwenden, können Sie:

Laden Sie die Software jetzt herunter

Andernfalls können Sie den folgenden Inhalt lesen, wenn Sie selbst basteln möchten.

Bereiten wir die GUI vor

Lassen Sie, wie im Bild gezeigt, die oberen 4 Zeilen des Excel-Blattes, um Kartendatum, Zone und Halbkugel zu halten. Diese 3 Werte werden für alle Zeilen in der Excel-Tabelle verwendet. In Zeile 5, starFügen Sie diese aus Spalte A als Überschriften hinzu

1. DLS_KEY
2. RM
3. OSTEN
4. NORDEN
5. LATITUDE
6. LÄNGENGRAD

Der Wert in den Spalten A bis Spalte D wird eingegeben und die Ausgabe, dh Breite und Länge, wird in den Spalten E und F angezeigt

Machen wir es funktionsfähig

Kopieren Sie das Skript in ein neues Modul und hängen Sie das Makro an die Schaltfläche auf dem Blatt an. Stellen Sie sicher, dass Ihr Computer über einen Internet Explorer verfügt. Ohne IE funktioniert dieses Skript nicht.

Lass es uns testen

Wenn Sie das Makro ausführen, können Sie den Status einfach über die Statusleiste Ihrer Excel-Anwendung verfolgen. Da wir zwischen jeder Konvertierung manuell eine Pause eingelegt haben, nimmt sich das Makro die Zeit, um alle Ihre UTM-Koordinaten in Lat- und Long-Werte zu konvertieren. Wenn alle Datensätze verarbeitet wurden, wird auf dem Bildschirm eine Popup-Meldung angezeigt. Wenn das Makro keine Daten auf Arbeitsblättern speichern kann, liegt dies möglicherweise an einer Beschädigung Ihrer Excel-Datei. Korrigieren Sie eine beschädigte Excel-Datei und führen Sie das Skript erneut aus.

Skript:

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

Einführung des Autors:

Nick Vipond ist ein Datenrettungsexperte in DataNumen, Inc., das weltweit führend bei Datenwiederherstellungstechnologien ist, einschließlich Dokumentdatei reparieren und Outlook Recovery-Softwareprodukte. Für weitere Informationen besuchen Sie www.datanumen.com €XNUMX