Comment convertir les coordonnées UTM en valeurs de latitude et de longitude via Excel VBA

Avec le convertisseur UTM, vous pouvez facilement convertir les coordonnées UTM en valeurs de latitude et de longitude. Une coordonnée UTM (Universal Transverse Mercator) est composée d'un numéro de zone, d'une abscisse, d'une ordonnée et d'un hémisphère (N/S).

Téléchargez

Si vous voulez start pour utiliser le logiciel dès que possible, alors vous pouvez :

Téléchargez le logiciel maintenant

Sinon, si vous voulez bricoler, vous pouvez lire le contenu ci-dessous.

Préparons l'interface graphique

Comme le montre l'image, laissez les 4 premières lignes de la feuille Excel pour contenir le Datum de la carte, la Zone et l'Hémisphère. Ces 3 valeurs seront utilisées pour toutes les lignes de la feuille Excel. À la rangée 5, starting de la colonne A, ajoutez-les comme en-têtes

1. DLS_KEY
2. RM
3. EST
4. NORD
5. LATITUDE
6. LONGITUDE

La valeur des colonnes A à la colonne D est saisie et la sortie, c'est-à-dire la latitude et la longitude, s'affiche dans les colonnes E et F

Rendons-le fonctionnel

Copiez le script dans un nouveau module et attachez la macro au bouton sur la feuille. Assurez-vous que votre ordinateur dispose d'Internet Explorer. Sans IE, ce script ne fonctionnera pas.

Testons-le

Lorsque vous exécutez la macro, vous pouvez facilement suivre l'état à partir de la barre d'état de votre application Excel. Comme nous avons induit manuellement une pause entre chaque conversion, la macro prendra le temps de convertir toutes vos coordonnées UTM en valeurs Lat et Long. Lorsque tous les enregistrements sont traités, vous pouvez voir un message contextuel à l'écran. Si la macro n'est pas en mesure d'enregistrer des données sur des feuilles, cela peut être dû à une corruption de votre fichier Excel. Réparer le fichier Excel corrompu et exécutez à nouveau le script.

Scénario:

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

Introduction de l'auteur:

Nick Vipond est un expert en récupération de données dans DataNumen, Inc., qui est le leader mondial des technologies de récupération de données, y compris réparer le fichier doc et produits logiciels de récupération Outlook. Pour plus d'informations, visitez www.datanumen.com