LoginSignup
1
4

More than 3 years have passed since last update.

@pbjpkas

Excel VBAでバイナリデータのRS-232C通信

Last updated at Posted at 2019-11-03

1. はじめに

Excel VBAでRS-232C通信の続編です。アプリ実行時の消費電力チェックを自動化する検討で使用しているSD-WWC01をExcel VBAで制御できるようRS-232C通信でバイナリデータの送受信をできるようにします。

2019/11/4更新
テストベンチにテキストデータで制御する機器とバイナリデータで制御する機器が混在しても対応できるように加筆修正しました。

2. バイナリデータ送受信の改修ポイント

変更箇所 テキストのみ バイナリ&テキスト両対応
ReadFile ByVal lpBuffer As String, _ lpBuffer As Any, _ 1
WriteFile ByVal lpBuffer As String, _ lpBuffer As Any, _ 1
ReadFileの第二引数 String型 Byte型、かつ、ReDim()でサイズを指定する2
WriteFileの第二引数 String型 Byte型、かつ、ReDim()でサイズを指定する2

3. 実装

3.1 Excelシート

バイナリでコマンドを送受信するSD-WWC01とテキストでコマンドを送受信するM5Stackを一つのExcelシートで扱います。
ExcelVBA_RS232C_binary-and-text.png

セル 用途
C4 SD-WWC01のCOMポートを指定します
D4 M5StackのCOMポートを指定します
C5 CreateFile()の戻り値を表示します
(-1が返ってきたときは"Can't Open COM#"を表示します)
C12～C15 SD-WWC01の測定データを16進数で表示します
D12～D15 SD-WWC01の測定データを10進数で表示します
(電圧は100.0で割っています)
ボタン 用途
Change Display SD-WWC01へ&Hf1を送信し画面を切り替えます
(changeSDWWC01()を登録しています)
Measure Value SD-WWC01へ&Hf0を送信し電圧や電流などの測定データを受信します
(measureSDWWC01()を登録しています)
Clear Value Handler IDやSD-WWC01の測定データの欄をクリアします
(clearValue()を登録しています)
keyspc M5Stackへ文字列"keyspc"を送信します
(sendCmdToM5Stack_keyspc()を登録しています)
keyla M5Stackへ文字列"keyla"を送信します
(sendCmdToM5Stack_keyla()を登録しています)
keyra M5Stackへ文字列"keyra"を送信します
(sendCmdToM5Stack_keyra()を登録しています)

3.2 ソースコード

RS232C_SD-WWC01_M5Stack.xlsm
Option Explicit

Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
   (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Private Declare Sub CloseHandle Lib "kernel32" _
   (ByVal handle As Long)

Private Declare Sub ReadFile Lib "kernel32" _
   (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
          lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long)

Private Declare Sub WriteFile Lib "kernel32" _
   (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
          lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long)

'SetCommState
Private Type DCB
    DCBlength As Long
    BaudRate As Long
    Fields As Long
    wReserved1 As Integer
    XonLim As Integer
    XoffLim As Integer
    ByteSize As Byte
    Parity As Byte
    StopBits As Byte
    XonChar As Byte
    XoffChar As Byte
    ErrorChar As Byte
    EofChar As Byte
    EvtChar As Byte
    wReserved2 As Integer
End Type
Private Declare Function GetCommState Lib "kernel32" _
   (ByVal hFile As Long, _
    ByRef lpDCB As DCB) As Long
Private Declare Function SetCommState Lib "kernel32" _
   (ByVal hFile As Long, _
    ByRef lpDCB As DCB) As Long

'SetCommTimeouts
Private Type COMMTIMEOUTS
    ReadIntervalTimeout As Long
    ReadTotalTimeoutMultiplier As Long
    ReadTotalTimeoutConstant As Long
    WriteTotalTimeoutMultiplier As Long
    WriteTotalTimeoutConstant As Long
End Type
Private Declare Sub SetCommTimeouts Lib "kernel32" _
   (ByVal hFile As Long, _
          lpCommTimeouts As COMMTIMEOUTS)

'CreateFile
Const GENERIC_READ = (&H80000000)
Const GENERIC_WRITE = (&H40000000)
Const OPEN_EXISTING = 3

Const COM_PORT_SDWWC01 = "C4"
Const COM_PORT_M5STACK = "D4"
Const COM_PORT_HANDLER = "C5"
Const RESULT_ID_HEX = "C12"
Const RESULT_ID_DEC = "D12"
Const RESULT_VOLTAGE_HEX = "C13"
Const RESULT_VOLTAGE_DEC = "D13"
Const RESULT_CURRENT_HEX = "C14"
Const RESULT_CURRENT_DEC = "D14"
Const RESULT_POWER_HEX = "C15"
Const RESULT_POWER_DEC = "D15"

Function sendCmdToSDWWC01(Cmd As Byte)
    Dim comPort As String
    Dim hFile As Long
    Dim cs As DCB 'CommState
    Dim ct As COMMTIMEOUTS 'CommTimeouts
    Dim length As Long
    Dim txBuf() As Byte
    ReDim txBuf(1) As Byte
    Dim rxBuf() As Byte
    ReDim rxBuf(130) As Byte

    comPort = ActiveSheet.Range(COM_PORT_SDWWC01)

    'COMポートオープン
    hFile = CreateFile(comPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)

    If hFile = -1 Then
        ActiveSheet.Range(COM_PORT_HANDLER) = "Can't Open " & comPort
        Exit Function
    Else
        ActiveSheet.Range(COM_PORT_HANDLER) = hFile
    End If

    On Error GoTo hClose

    'RS232C通信設定
    GetCommState hFile, cs
    cs.BaudRate = 9600
    cs.ByteSize = 8
    cs.Parity = 0
    cs.StopBits = 0
    cs.Fields = &H1
    SetCommState hFile, cs

    'RS232Cタイムアウト設定
    ct.ReadIntervalTimeout = 10
    ct.ReadTotalTimeoutMultiplier = 0
    ct.ReadTotalTimeoutConstant = 500
    ct.WriteTotalTimeoutMultiplier = 0
    ct.WriteTotalTimeoutConstant = 500
    SetCommTimeouts hFile, ct

    If Cmd = &HF1 Then
        txBuf(0) = Cmd
        WriteFile hFile, txBuf(0), 1, length, 0

    ElseIf Cmd = &HF0 Then
        txBuf(0) = Cmd
        WriteFile hFile, txBuf(0), 1, length, 0
        Sleep 200 'for the time being...
        ReadFile hFile, rxBuf(0), 130, length, 0

        '2^8 means 8bit Left Shift
        ActiveSheet.Range(RESULT_ID_HEX) = "0x" + Hex(rxBuf(0) * (2 ^ 8) + rxBuf(1))
        ActiveSheet.Range(RESULT_VOLTAGE_HEX) = "0x" + Hex(rxBuf(2) * (2 ^ 8) + rxBuf(3))
        ActiveSheet.Range(RESULT_CURRENT_HEX) = "0x" + Hex(rxBuf(4) * (2 ^ 8) + rxBuf(5))
        ActiveSheet.Range(RESULT_POWER_HEX) = "0x" + Hex(rxBuf(8) * (2 ^ 8) + rxBuf(9))

        ActiveSheet.Range(RESULT_ID_DEC).Value = rxBuf(0) * (2 ^ 8) + rxBuf(1)
        ActiveSheet.Range(RESULT_VOLTAGE_DEC).Value = (rxBuf(2) * (2 ^ 8) + rxBuf(3)) / 100#
        ActiveSheet.Range(RESULT_CURRENT_DEC).Value = rxBuf(4) * (2 ^ 8) + rxBuf(5)
        ActiveSheet.Range(RESULT_POWER_DEC).Value = rxBuf(8) * (2 ^ 8) + rxBuf(9)

        ActiveSheet.Range(RESULT_VOLTAGE_DEC).NumberFormatLocal = "0.00"

    End If

    CloseHandle hFile

    Exit Function

hClose:
    CloseHandle hFile

End Function

Function sendCmdToM5Stack(strCmd As String)
    Dim comPort As String
    Dim hFile As Long
    Dim cs As DCB 'CommState
    Dim ct As COMMTIMEOUTS 'CommTimeouts
    Dim length As Long
    Dim txBuf() As Byte
    Dim rxBuf() As Byte
    Dim i As Long
    Dim char As String
    Dim asciiCode As Integer
    Dim strLength As Long

    comPort = ActiveSheet.Range(COM_PORT_M5STACK)

    'COMポートオープン
    hFile = CreateFile(comPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)

    If hFile = -1 Then
        ActiveSheet.Range(COM_PORT_HANDLER) = "Can't Open " & comPort
        Exit Function
    Else
        ActiveSheet.Range(COM_PORT_HANDLER) = hFile
    End If

    On Error GoTo hClose

    'RS232C通信設定
    GetCommState hFile, cs
    cs.BaudRate = 115200 'M5Stack
    cs.ByteSize = 8
    cs.Parity = 0
    cs.StopBits = 0
    cs.Fields = &H11 'To avoid reset M5Stack at begining serial-communicaton
    SetCommState hFile, cs

    'RS232Cタイムアウト設定
    ct.ReadIntervalTimeout = 10
    ct.ReadTotalTimeoutMultiplier = 0
    ct.ReadTotalTimeoutConstant = 500
    ct.WriteTotalTimeoutMultiplier = 0
    ct.WriteTotalTimeoutConstant = 500
    SetCommTimeouts hFile, ct

    strLength = Len(strCmd)
    ReDim txBuf(strLength)

    For i = 0 To strLength - 1
        char = Mid(strCmd, i + 1, 1)
        asciiCode = Asc(char)
        txBuf(i) = CByte(asciiCode)
        'Debug.Print Chr(txBuf(i))
    Next
    txBuf(i) = &HD 'add 0x0D(CR)

    WriteFile hFile, txBuf(0), strLength + 1, length, 0
    Sleep 1 'To avoid reset M5Stack

    ReDim rxBuf(strLength + 7)
    ReadFile hFile, rxBuf(0), strLength + 8, length, 0
    For i = 0 To strLength + 7
        Debug.Print Hex(rxBuf(i))
    Next

    CloseHandle hFile

    Exit Function

hClose:
    CloseHandle hFile

End Function

Sub changeSDWWC01()
    Call sendCmdToSDWWC01(&HF1)
End Sub

Sub measureSDWWC01()
    Call clearValue
    Call sendCmdToSDWWC01(&HF0)
End Sub

Sub clearValue()
    ActiveSheet.Range(COM_PORT_HANDLER) = ""
    ActiveSheet.Range(RESULT_ID_HEX) = ""
    ActiveSheet.Range(RESULT_ID_DEC) = ""
    ActiveSheet.Range(RESULT_VOLTAGE_HEX) = ""
    ActiveSheet.Range(RESULT_VOLTAGE_DEC) = ""
    ActiveSheet.Range(RESULT_CURRENT_HEX) = ""
    ActiveSheet.Range(RESULT_CURRENT_DEC) = ""
    ActiveSheet.Range(RESULT_POWER_HEX) = ""
    ActiveSheet.Range(RESULT_POWER_DEC) = ""
End Sub

Sub sendCmdToM5Stack_keyspc()
    Call sendCmdToM5Stack("keyspc")
End Sub

Sub sendCmdToM5Stack_keyla()
    Call sendCmdToM5Stack("keyla")
End Sub

Sub sendCmdToM5Stack_keyra()
    Call sendCmdToM5Stack("keyra")
End Sub

3.2.1 バイナリデータ送受信(sendCmdToSDWWC01)の補足

  • Excel VBAはビットシフト演算子(いわゆる<<や>>)がないので$2^n$(nはシフトさせたいビット数)を掛けることで代替しています。"2^8"で8ビット(1バイト)左シフトします。
    • Excel 2013以降であればBITLSHIFT関数(やBITRSHIFT関数)が提供されているのでWorksheetFunction.Bitlshift(数値、シフト量)を使う方法もあります。
  • セルに16進数の値を書くときはHex()を使います。
  • エラー発生時にブレークポイントを張ってデバッグしたりハンドラをクローズしたりできるよう"On Error GoTo"でエラー処理に飛ぶようにしています。

3.2.2 テキストデータ送受信(sendCmdToM5Stack)の補足

  • 引数で受け取った文字列に改行コード(0x0D; CR)を付加して機器(M5Stack)へ送信します。
  • その後、機器から送られてきたデータをイミディエイトウィンドウへ16進数で出力します。
    • 受信バイト数は筆者のM5Stackのファームウェア実装に合わせて文字列長+8としています。
  • 文字列のバイナリ変換は、引数の文字列を一文字ずつMid()で取り出し、Asc()でアスキーコードへ変換し、CByte()でバイト型にキャストして送信バッファへコピーして行っています3。
  • シリアル通信のスタートと同時にM5Stackがリセットしないよう以下の設定を加えています。
    • CommStateのFieldの設定値を0x11にする4 5。
    • 脚注4の記事ではDTRをFalseにすることでリセットされなくなったとありますが筆者のM5StackはDTR_CONTROL_ENABLE(0x01)を設定することでリセットされなくなりました。
    • WriteFile()の直後にハンドラをクローズするとリセットがかかるためSleep 1を追加。

4. おわりに

  • Excel VBAにビットシフト演算子がないのは意外でした。
  • 大掛かりな改修なしにバイナリデータの送受信ができました。
  • 文字列をアスキーコードに変換することでテキストデータの送受信もできるようになりました。
  • テキストデータ送受信とバイナリデータ送受信のハイブリッド対応は改めて記事にまとめようと思います。対応しました。

  1. APIを使ったRs232cでバイナリを入力する ↩

  2. windows10(64bit) Excel2016 のVBAを使って、COMポート通信（RS-232C)をやりたいと思っています。 ↩

  3. VBA Asc 関数 ↩

  4. arduinoがシリアル通信時にリセットされる原因が分かりました ↩

  5. DCB structure ↩

1
4
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
1
4