こんにちは、Ryoです。
今回はT&D製のデータロガー「TR73U」おんどとりの現在値をExcel-VBAで取り込むコードについてご紹介したいと思います。
小型で安価、且つ測定精度も悪くないですから良い商品だと思います。
この製品の通信方法はUSBかシリアルの2通りがあるのですが、私はEasyCommを使って
シリアル通信していますので、その内容になります。
EasyCommについては以前の記事で簡単ですが紹介していますので、良かったら
こちらをご確認ください。
1.データロガー「TR-73U」について
先ず最初に製品について簡単にご紹介しますと、とても小型で温度／湿度／大気圧を同時測定してくれる製品で、USB／シリアル通信も可能です。
この通信の部分が他社と違って通信仕様を開示してくれるという点がとても良いです。
私は製品測定時の環境データを特性データと合わせて記録したかったので、通信出来るものを
探していましたがリーズナブルな価格で且つユーザー側でプログラム処理させてくれる製品は
T&D社だけでしたね。ほんと助かります。
◆T&D 温湿度・大気圧データロガー おんどとり TR-73U
・センサ:(サーミスタ/高分子膜抵抗式)、大気圧センサ(内蔵)
・測定チャンネル:温度 1ch /湿度 1ch /大気圧 1ch
・測定範囲:温度:0~50℃
・湿度:10~95 %RH
・大気圧:750~1100 hPa
・測定分解能:温度:0.1℃/湿度:1%RH/大気圧:0.1 hPa
・データ記録容量:8,000個 x 3ch
・記録間隔:1, 2, 5, 10, 15, 20, 30 秒 1, 2, 5, 10, 15, 20,
30,60 分 (15通りから選択)
◆T＆D シリアル通信ケーブル TR-07C
USBケーブルは本体に付属していますが、
シリアル通信の場合はこちらのケーブルが
必要になります。
・ケーブル長：約1.0ｍ
・コネクタ形状：専用コネクタ-D-sub9ピン
通信仕様書については、こちらの公式ページからお問い合わせで依頼するとパスワードを
教えてもらえますので、それでダウンロードできます。
2.Excelサンプル画面
今回ご紹介するサンプル用として簡易的な表を作ってますので、画面のように対象セルに
温度／湿度／大気圧を表示させたいと思います。
３．コード全体と解説
コード全体としては以下の通りになります。
Sub Tr73u_Serial()
ec.COMn = 3
ec.Setting = "19200,n,8,1" 'ボーレート19200、パリティなし、データビット8、ストップビット1
ec.WAITmS = 1000
ec.Ascii = Chr(0) 'NULLを1バイト送信しアクティブ状態にする
'↓現在値読取りコマンドの送信
ec.Ascii = Chr(&H1) & Chr(&H33) & Chr(0) & Chr(&H4) & Chr(0) & _
Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(&H38) & Chr(0)
ec.WAITmS = 200
Dim S_Time As Date 'TimeOut設定用
Dim binary_data() As Byte ' バイナリデータ格納用
Dim Temp, Hum, At_Press As Double
S_Time = Now ' 現在時刻読み込み
ec.BinaryBytes = 26 ' 受信バッファから全データ（26バイト）を取得
Cells(3, 2) = S_Time
Do
If Now > S_Time + TimeSerial(0, 0, 2) Then Exit Sub 'TimeOut 2sec
DoEvents
If ec.InBuffer >= 10 Then ' 10バイト以上を受信
DoEvents
binary_data() = ec.Binary '配列へ格納
Exit Do
End If
Loop
'対象となる受信データを16進数に変換後、数値化＆10進数に変換する
'後はT&D社の通信仕様に記載されているFormatに従い計算して求める。
'温度 = （DATA-1000)/10
Temp = (CInt(Val("&H" + (Right("0" & Hex(binary_data(6)), 2) & _
Right("0" & Hex(binary_data(5)), 2)))) - 1000) / 10
Cells(4, 2) = Temp
'湿度 = (DATA-1000)/10
Hum = (CInt(Val("&H" + (Right("0" & Hex(binary_data(8)), 2) & _
Right("0" & Hex(binary_data(7)), 2)))) - 1000) / 10
Cells(5, 2) = Hum
'気圧 = DATA/10
At_Press = CInt(Val("&H" + (Right("0" & Hex(binary_data(10)), 2) & _
Right("0" & Hex(binary_data(9)), 2)))) / 10
Cells(6, 2) = At_Press
ec.COMn = -1
End Sub
通信用コマンドは通信仕様書に記載されていますので、準じて記述するとこの様な形です。
PC⇒TR-73UへAsciiで送信しています。
記述内の ec.Ascii = Chr(&H1) & Chr(&H33) & Chr(0) & Chr(&H4) & Chr(0) & _
Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(&H38) & Chr(0)の部分になります。
受信データはバイナリで取得しますのでbinary_data（）に格納します。
その際の一例としては以下となっています。
受信するデータはTotalで26バイトあり、その内温度／湿度／大気圧の部分は
上表に示す通りbinary_data(5)～(10)になります。
受信データを16進数に置換しますので、上の例では温度が「04 F1」、
湿度が「06 41」、大気圧が「26 F9」となります。
（例 ： 04 F1 ⇒ 1+15*16+4*16^2+0=DATA)
このデータから計算して10進とし、通信仕様書に従って表示値になるよう計算します。
‘温度 = （DATA-1000)/10
Temp = (CInt(Val(“&H” + (Right(“0” & Hex(binary_data(6)), 2) & _
Right(“0” & Hex(binary_data(5)), 2)))) – 1000) / 10
‘湿度 = (DATA-1000)/10
Hum = (CInt(Val(“&H” + (Right(“0” & Hex(binary_data(8)), 2) & _
Right(“0” & Hex(binary_data(7)), 2)))) – 1000) / 10
‘気圧 = DATA/10
At_Press = CInt(Val(“&H” + (Right(“0” & Hex(binary_data(10)), 2) & _
Right(“0” & Hex(binary_data(9)), 2)))) / 10
後はこの結果を対象セルに表示させれば、上のサンプル画面に様に現在表示値を
取り込めます。
◆参考：5分間隔で連続データ収集を行うサンプル
以下の画像に示すような表に連続でデータ収集を行いたい場合もあるかと思いますので、簡易的なものですが参考までにサンプルコードを書いてみます。
この場合、上に記述したサンプルコードに繰り返し処理などを少し追加すれば大丈夫です。
Sub roomTemp()
ec.COMn = 3
ec.Setting = "19200,n,8,1" 'ボーレート19200、パリティなし、データビット8、ストップビット1
ec.WAITmS = 1000
Do
ec.Ascii = Chr(0) 'NULLを1バイト送信しアクティブ状態にする
'↓現在値読取りコマンドの送信
ec.Ascii = Chr(&H1) & Chr(&H33) & Chr(0) & Chr(&H4) & Chr(0) & _
Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(&H38) & Chr(0)
ec.WAITmS = 200
Dim S_Time As Date 'TimeOut設定用
Dim binary_data() As Byte ' バイナリデータ格納用
Dim Temp, Hum, At_Press As Double
S_Time = Now ' 現在時刻読み込み
ec.BinaryBytes = 26 ' 受信バッファから全データ（26バイト）を取得
ActiveCell = S_Time
Do
If Now > S_Time + TimeSerial(0, 0, 2) Then Exit Sub 'TimeOut 2sec
DoEvents
If ec.InBuffer >= 10 Then ' 10バイト以上を受信
DoEvents
binary_data() = ec.Binary '配列へ格納
Exit Do
End If
Loop
'対象となる受信データを16進数に変換後、数値化＆10進数に変換する
'後はT&D社の通信仕様に記載されているFormatに従い計算して求める。
'温度 = （DATA-1000)/10
Temp = (CInt(Val("&H" + (Right("0" & Hex(binary_data(6)), 2) & _
Right("0" & Hex(binary_data(5)), 2)))) - 1000) / 10
ActiveCell.Offset(0, 1) = Temp
'湿度 = (DATA-1000)/10
Hum = (CInt(Val("&H" + (Right("0" & Hex(binary_data(8)), 2) & _
Right("0" & Hex(binary_data(7)), 2)))) - 1000) / 10
ActiveCell.Offset(0, 2) = Hum
'気圧 = DATA/10
At_Press = CInt(Val("&H" + (Right("0" & Hex(binary_data(10)), 2) & _
Right("0" & Hex(binary_data(9)), 2)))) / 10
ActiveCell.Offset(0, 3) = At_Press
ActiveCell.Offset(1, 0).Select
ec.WAITmS = 300000
Loop
ec.COMn = -1
End Sub
データを取り込む部分は基本的に同じなので、繰り返し処理のDo～Loopや5分間隔で実行するためのec.WAITmS = 300000が追加されたものになります。
セルへの書き込みはスタート位置の指定やセルの空きを探して入力位置を自動判定させることもできるのですが、私の場合はその都度任意に決めれるように特に位置指定や検索などを実行していないので、スタート時に選択されているセルから開始される形になっています。
4.まとめ
このサイズと精度で温度／湿度／大気圧のデータロガーはあるようでないので、このTR-73Uは結構気に入っています。一度データ収集できる形でつくっておくと何かと有用なので、必要性を感じる場合は検討されてみるのもよいかと思います。
以上がTR73Uからのデータ取り込みに関するVBAコードでした。
他にもやり方あるように思えますので、時間あれば色々やってみようとは思ってます。
特にUSBとかですね。
今回ご紹介した内容が何かのお役にたてれば幸いです。
Ryo
