LoginSignup
6
9

More than 5 years have passed since last update.

Excel VBAでRS-232C通信

Posted at

1. はじめに

ArduinoとオシロスコープをExcelで制御して測定する(2) シャッタースピードの自動測定ではVISAライブラリを利用してArduinoと測定器を制御していますが、測定器は使用せずArduinoを制御するだけならVISAライブラリは必須ではありません。

3. 測定器やマイコンを制御するExcelマクロを以下のように変更することでVISAライブラリを使用せずにRS-232C通信ができます。

  • ControlDSO()およびControlDSOの呼出し元をコメントアウトないし削除する
  • C7セルにVISA AddressではなくCOMポート名(例:COM6)を記述する
  • ControlTB()を以下のプログラムで置き換える

2. プログラム

Option Explicit
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 hObject As Long)

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

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

'SetCommState
Private Type DCB
    DCBlength As Long
    BaudRate As Long
    Fields As Long
    wReserved 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
    wReserved1 As Integer
End Type
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_TB = "C7"     'TB  : Target Board

Function ControlTB(line As Long, strTxd As String, colRxd As Long)
    Dim comPort As String
    Dim hFile As Long
    Dim cs As DCB          'CommState
    Dim ct As COMMTIMEOUTS 'CommTimeouts
    Dim length As Long
    Dim buf As String

    comPort = ActiveSheet.Range(COM_PORT_TB)

    'COMポートオープン
    hFile = CreateFile(comPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
    If hFile = -1 Then
        MsgBox "Can't Open " & comPort
        Exit Function
    End If
    'MsgBox (hFile)

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

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

    '送信
    buf = strTxd + Chr(10)
    WriteFile hFile, buf, Len(buf), length, 0

    '受信
    buf = String(1024, vbNullChar)
    ReadFile hFile, buf, Len(buf), length, 0

    'COMポートクローズ
    CloseHandle hFile

    '受信データのパース
    buf = Replace(buf, vbNullChar, "")
    buf = Replace(buf, Chr(10), "/")
    buf = Replace(buf, Chr(13), "")
    If buf <> "" Then
        ActiveSheet.Cells(line, colRxd).Value = buf
    End If

End Function

3. 参考資料

CreateFile
CloseHandle
ReadFile
WriteFile
SetCommState
SetCommTimeouts
通信制御用APIを使ったシリアル通信プログラム開発
VBA(EXCEL)でCOMポート通信 SHOJI's Code - 各種言語のプログラミングコード

6
9
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
6
9