VBAシリアル通信でT&D製TR73Uの現在値をPCに取り込む!

PC関連

こんにちは、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.0m
・コネクタ形状:専用コネクタ-D-sub9ピン

通信仕様書については、こちらの公式ページからお問い合わせで依頼するとパスワードを
教えてもらえますので、それでダウンロードできます。

2.Excelサンプル画面

今回ご紹介するサンプル用として簡易的な表を作ってますので、画面のように対象セルに
温度/湿度/大気圧を表示させたいと思います。

3.コード全体と解説

コード全体としては以下の通りになります。

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" + (Format(Hex(binary_data(6)), "00") & _
    Format(Hex(binary_data(5)), "00")))) - 1000) / 10
    Cells(4, 2) = Temp
    
    '湿度 = (DATA-1000)/10
    Hum = (CInt(Val("&H" + (Format(Hex(binary_data(8)), "00") & _
    Format(Hex(binary_data(7)), "00")))) - 1000) / 10
    Cells(5, 2) = Hum
    
    '気圧 = DATA/10
    At_Press = CInt(Val("&H" + (Format(Hex(binary_data(10)), "00") & _
    Format(Hex(binary_data(9)), "00")))) / 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()

 '※5分間隔で連続データ収集を行うサンプル※
    
 'アクティブセル(選択されているセル)を基準として、
 '温度/湿度/気圧をそれぞれ書込み、次の行に移動しながら
 '連続で書込みを繰り返していく簡易的な動作
                     
 ec.COMn = 3  'COMポートを設定(接続ポートは
              '環境により異なるので適宜設定が必要)
 ec.Setting = "19200,n,8,1"
 ec.WAITmS = 1000
   
 Do  '繰り返し処理・・・終了条件を本サンプルでは設定していないので、
     '         停止はマニュアル操作で行う
    ec.Ascii = Chr(0)
    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
    Dim binary_data()   As Byte
    Dim Temp, Hum, At_Press As Double
    
     S_Time = Now
     ec.BinaryBytes = 26
     ActiveCell = S_Time  'データ収集日時をセルへ書込み
   
        Do
          If Now > S_Time + TimeSerial(0, 0, 2) Then Exit Sub
          DoEvents
   
          If ec.InBuffer >= 10 Then
            DoEvents
            binary_data() = ec.Binary
            Exit Do
          End If
        Loop
    '「温度」
    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  'セルへの書込み
    '「湿度」
    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  'セルへの書込み
    '「気圧」
    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 '約5分周期でのデータ収集(1分=60000msec)
    
 Loop
    
    ec.COMn = -1
  
End Sub

データを取り込む部分は基本的に同じなので、繰り返し処理のDo~Loopや5分間隔で実行するためのec.WAITmS = 300000が追加されたものになります。

セルへの書き込みはスタート位置の指定やセルの空きを探して入力位置を自動判定させることもできるのですが、私の場合はその都度任意に決めれるように特に位置指定や検索などを実行していないので、スタート時に選択されているセルから開始される形になっています。

4.まとめ

このサイズと精度で温度/湿度/大気圧のデータロガーはあるようでないので、このTR-73Uは結構気に入っています。一度データ収集できる形でつくっておくと何かと有用なので、必要性を感じる場合は検討されてみるのもよいかと思います。



以上がTR73Uからのデータ取り込みに関するVBAコードでした。
他にもやり方あるように思えますので、時間あれば色々やってみようとは思ってます。
特にUSBとかですね。

今回ご紹介した内容が何かのお役にたてれば幸いです。

Ryo

タイトルとURLをコピーしました