UTMコンバータを使用すると、UTM座標を緯度と経度の値に簡単に変換できます。 ユニバーサル横メルカトル図法（UTM）座標は、ゾーン番号、東向き、北向き、および半球（N / S）で構成されます。
ダウンロード
ソフトウェアをできるだけ早く使い始めたい場合は、以下の方法があります。
それ以外の場合、DIYをしたい場合は、以下の内容を読むことができます。
GUIを準備しましょう
画像に示すように、Excelシートの一番上の4行は、地図の測地系、ゾーン、半球を格納するために空けておきます。これらの3つの値は、Excelシートのすべての行で使用されます。5行目、A列から始めて、これらをヘッダーとして追加します。
- DLS_KEY
- RM
- 簡単にする
- ノース
- 緯度
- 経度
列Aから列Dの値が入力され、出力、つまり緯度と経度が列EとFに表示されます。
機能させましょう
スクリプトを新しいモジュールにコピーし、マクロをシートのボタンに添付します。 お使いのマシンにInternetExplorerが搭載されていることを確認してください。 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
著者紹介：
Nick Vipondは、のデータ復旧の専門家です。 DataNumen、Inc。は、以下を含むデータ復旧技術の世界的リーダーです。 ドキュメントファイルを修復します と見通し回復ソフトウェア製品。 詳細については、次のWebサイトをご覧ください。 WWW。datanumen.com