MITSUBISHI MX Component を Excel VBA で使う （2016/07/16)
■Excel VBA で MX Componet を使ってみました。
・FX5UCPU の Ethernet ポート直結接続です。
・通信エラー中のみ、Application.OnTime で、2 秒周期で、再接続を試みます。
・デバイスの値の取得は、MX Component のイベント OnDeviceStatus を使って 1 秒周期で取得しています。
Option Explicit
'' ■概要
'' ワークブックを開くと、自動でPLCに接続する
'' 接続失敗、通信異常の場合は、2秒周期で接続を試みる
'' ダミーのビットデバイスを ONにし、状態監視のOnDeviceStatusイベントを
'' １秒周期で発生させ、この時に、必要なデバイスの情報を取得する
'’■注意事項
'' セル入力中は通信が止まる（マルチスレッドでは無い）
'' Application.OnTime で１秒ごとにデバイスの値を取得するより、
'' OnDeviceStatus イベント発生時に取得するほうが、負担が少ない
'' VBA コード編集時は、Application.OnTime、OnDeviceStatusイベントは、
'' 停止させたほうが良い
'' インタプリタのため、編集中のコードが周期的に走り、編集しにくくなる
'' 定数
Global Const CPU_FX5UCPU = &H210 ' FX5UCPU
Global Const UNIT_FXVETHER_DIREC = &H2002 ' FX5UCPU直結
' Global Const PROTOCOL_TCPIP = &H5 ' TCP/IP経由
Global Const PROTOCOL_UDPIP = &H8 ' UDP/IP経由
'' グローバル変数
Public GB_OpenFlag As Boolean
Public GB_TmBusyFlag As Boolean
'' 今回取得データ
Public GB_DataThis(2) As Long
Public GB_DataThis2(2) As Integer
Public GB_sDevice As String
'' *****************
'' Module1
'' *****************
'' 32 ビット実数（単精度）変換
'' Ex : HexToSingle("C2F6E666") result = -123.45
Public Function HexToSingle(sHex As String) As Single
Dim sTemp As String
Dim iSign, iExponent As Integer
Dim fTemp, fFraction As Single
' 符号 1ビット
sTemp = Mid(sHex, 1, 1)
fTemp = Val("&H" & sTemp) And &H8
iSign = IIf(fTemp = 8, -1, 1)
' 指数部 8ビット
sTemp = Mid(sHex, 1, 3)
fTemp = Val("&H" & sTemp) And &H7F8
iExponent = fTemp / 2 ^ 3 - 127 '32ビット形式のバイアス=127
' 仮数部 23ビット
sTemp = Mid(sHex, 3, 6)
fTemp = Val("&H" & sTemp) And &H7FFFFF
fFraction = 1# + (fTemp / 2 ^ 23)
HexToSingle = iSign * fFraction * 2 ^ iExponent
End Function
'' 64 ビット実数（倍精度）変換
'' Ex : HexToDouble("C05EDD2F1A9FBE77") Result = -123.456
Public Function HexToDouble(sHex As String) As Double
Dim sTemp As String
Dim iSign, iExponent As Integer
Dim fTemp, fFraction As Double
' 符号 1ビット
sTemp = Mid(sHex, 1, 1)
fTemp = Val("&H" & sTemp) And &H8
iSign = IIf(fTemp = 8, -1, 1)
' 指数部 11ビット
sTemp = Mid(sHex, 1, 3)
fTemp = Val("&H" & sTemp) And &H7FF
iExponent = fTemp - 1023 '64ビット形式のバイアス=1023
' 仮数部 52ビット
sTemp = Mid(sHex, 4, 13)
fTemp = CDbl("&H" & sTemp)
fFraction = 1 + (fTemp / 2 ^ 52)
HexToDouble = iSign * fFraction * 2 ^ iExponent
End Function
'' オープン
Sub PLC_Open()
On Error Resume Next
Dim lRet As Long
With Worksheets("Sheet1").ActProgType1
If Not GB_OpenFlag Then
''*******************************
''FX5UCPU Ethernetポート 直結接続
''*******************************
.ActUnitType = UNIT_FXVETHER_DIREC 'ユニットタイプ
.ActProtocolType = PROTOCOL_UDPIP '通信プロトコルタイプ
.ActNetworkNumber = 0 'ネットワーク番号(0=自局)
.ActStationNumber = 255 '局番号(自局指定時は“255”(0xFF) を指定)
.ActUnitNumber = 0 'ユニット番号(自ネットワーク内アクセスの場合は“0”(0x00)固定)
.ActConnectUnitNumber = 0 'ユニット番号
.ActIONumber = &H3FF 'ユニットI/O 番号(自局CPUは、“1023”(0x3FF)固定)
.ActCpuType = CPU_FX5UCPU 'CPUタイプ
'' 直結接続の場合
.ActHostAddress = "255.255.255.255" '接続ホスト名（IP アドレス）文字列
.ActDestinationPortNumber = &H15B8
.ActDestinationIONumber = 0
.ActCpuTimeOut = 0 'CPU 監視タイマ(単位は"×250ms")
.ActTimeOut = 500 '通信のタイムアウト値(単位は"ms")
'' オープン
lRet = .Open()
'' 正常終了
If (lRet = 0) Then
GB_OpenFlag = True
'' すでにオープン済
ElseIf (lRet = &HF0000003) Then
'' 一度クローズ
Call .Close
'' 再度オープン
lRet = .Open()
If (lRet = 0) Then: GB_OpenFlag = True
End If
'' 状態監視のため、ダミー点をＯＮ
If GB_OpenFlag Then
Call .SetDevice(GB_sDevice, 1)
End If
End If
End With
End Sub
'' クローズ
Sub PLC_Close()
On Error Resume Next
With Worksheets("Sheet1").ActProgType1
If GB_OpenFlag Then
.Close
GB_OpenFlag = False
End If
End With
End Sub
'' 状態監視デバイスを登録
Sub SetDeviceStatus()
'' リセットされた時のため
If GB_sDevice = "" Then: GB_sDevice = "M96"
Dim lEntryData(1) As Long
'' ONを監視
lEntryData(0) = 1
With Worksheets("Sheet1")
'' 状態監視削除
Call .ActProgType1.FreeDeviceStatus
'' 状態監視登録（M96 の 1 個、1 秒周期
Call .ActProgType1.EntryDeviceStatus(GB_sDevice, 1, 1, lEntryData(0))
End With
End Sub
'' オープン再試行タイマー
Sub TimerProc2()
If Not GB_TmBusyFlag Then
GB_TmBusyFlag = True
With Worksheets("Sheet1").Cells(1, 1)
'' 通信中「青色」点滅表示
If .Font.Color <> RGB(255, 0, 255) Then: .Font.Color = RGB(255, 0, 0)
If .Value <> "■" Then: .Value = "■": Else .Value = "□"
End With
If Not GB_OpenFlag Then
'' オープン
Call PLC_Open
'' 状態監視を登録
If GB_OpenFlag Then: Call SetDeviceStatus
End If
'' オープン失敗
If Not GB_OpenFlag Then
'' タイマー起動
Application.OnTime Now + TimeValue("00:00:02"), "TimerProc2"
End If
GB_TmBusyFlag = False
End If
End Sub
'' ビットデータの結果を表示
Sub ResDisp1()
Dim i As Integer
Dim s As String
Dim lTemp As Long
With Worksheets("Sheet1")
lTemp = .Cells(5, 1).Value
For i = 0 To 15
s = .Cells(5 + i, 3).Value
If (lTemp And 2 ^ i) > 0 Then
If s <> "●" Then: .Cells(5 + i, 3).Value = "●"
Else
If s <> "○" Then: .Cells(5 + i, 3).Value = "○"
End If
Next
End With
End Sub
--------------------------------
Option Explicit
'' *****************
'' ThisWorkbook
'' *****************
'' クローズ
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'' 通信クローズ
Call PLC_Close
End Sub
'' ワークブックオープン
Private Sub Workbook_Open()
'' オープンフラグを初期化
GB_OpenFlag = False
'' 状態監視のためのダミーデバイス
GB_sDevice = "M96"
'' 初期状態
Dim obj As Object
With Worksheets("Sheet1")
Set obj = .OLEObjects("CommandButton1").Object
obj.Caption = "通信許可中"
'' バックカラ―：ボタン色
obj.BackColor = &H8000000F
'' 文字色：黒
obj.ForeColor = RGB(0, 0, 0)
'' オープン
Call PLC_Open
If GB_OpenFlag Then
'' 状態監視を登録
Call SetDeviceStatus
Else
'' オープン再試行
Call TimerProc2
End If
End With
End Sub
--------------------------------
Option Explicit
'' *****************
'' Sheet1 (Sheet1)
'' *****************
'' デバイス状態監視
'' GB_sDevice に設定されたビットデバイス（"M96"等）がＯＮの時は、１秒周期で実行される
Private Sub ActProgType1_OnDeviceStatus(ByVal szDevice As String, ByVal lData As Long, ByVal lReturnCode As Long)
On Error Resume Next
Dim lRet As Long
Dim dTemp As Double
Dim lTemp As Long
Dim iTemp As Integer
Dim s As String
If szDevice = GB_sDevice Then
If lReturnCode = 0 Then
'' 通信中「青色」点滅表示
With Worksheets("Sheet1").Cells(1, 1)
If .Font.Color <> RGB(0, 0, 255) Then: .Font.Color = RGB(0, 0, 255)
If .Value <> "■" Then: .Value = "■": Else .Value = "□"
End With
'' 読込処理
With Worksheets("Sheet1")
'' M0 から M15 までの 16 点を読み出す
lRet = .ActProgType1.ReadDeviceBlock("M0", 1, GB_DataThis(0))
If lRet = 0 Then
If .Cells(5, 1).Value <> GB_DataThis(0) Then
.Cells(5, 1).Value = GB_DataThis(0)
'' 結果を表示
Call ResDisp1
End If
End If
'' D0 を 16 ビット整数として読みだす
lRet = .ActProgType1.ReadDeviceBlock2("D0", 1, GB_DataThis2(0))
If lRet = 0 Then
''16ビット整数
iTemp = GB_DataThis2(0)
'' ReadDeviceBlock（LONGで取得）の時は、マイナス値表示のために必要
''If lTemp >= 2 ^ 15 Then: lTemp = lTemp - 2 ^ 16
If .Cells(21, 1).Value <> iTemp Then: .Cells(21, 1).Value = iTemp
End If
'' D0, D1 を 32 ビット整数として読みだす
lRet = .ActProgType1.ReadDeviceBlock("D0", 2, GB_DataThis(0))
If lRet = 0 Then
dTemp = GB_DataThis(1) * 2 ^ 16 + GB_DataThis(0)
If dTemp >= 2 ^ 31 Then: dTemp = dTemp - 2 ^ 32
If .Cells(22, 1).Value <> dTemp Then: .Cells(22, 1).Value = dTemp
End If
End With
End If
End If
'' エラー時、一度クローズし、再度オープンする
If lReturnCode <> 0 Then
With Worksheets("Sheet1").Cells(1, 1)
'' 通信異常「赤色」点灯表示
If .Font.Color <> RGB(255, 0, 0) Then: .Font.Color = RGB(255, 0, 0)
.Value = "■"
End With
'' オープン再試行
GB_OpenFlag = False
Call TimerProc2
End If
End Sub
'' 通信許可／禁止ボタン
'' ！！コード編集時は、通信禁止にすること！！
Private Sub CommandButton1_Click()
Dim obj As Object
With Worksheets("Sheet1")
'' 値がリセットされてしまった時のため
If GB_sDevice = "" Then GB_sDevice = "M96"
Set obj = .OLEObjects("CommandButton1").Object
If obj.Caption <> "通信許可中" Then
obj.Caption = "通信許可中"
'' バックカラ―：ボタン色
obj.BackColor = &H8000000F
'' 文字色：黒
obj.ForeColor = RGB(0, 0, 0)
GB_TmBusyFlag = False
GB_OpenFlag = False
'' オープン
Call PLC_Open
If GB_OpenFlag Then
'' 状態監視を登録
Call SetDeviceStatus
Else
'' オープン再試行
Call TimerProc2
End If
Else
obj.Caption = "通信禁止中"
'' バックカラ―：赤
obj.BackColor = RGB(255, 0, 0)
'' 文字色：白
obj.ForeColor = RGB(255, 255, 255)
'' 状態監視のためのダミー点を OFF
'' これにより、OnDeviceStatus イベントは発生しなくなる
If GB_OpenFlag Then
Call .ActProgType1.SetDevice(GB_sDevice, 0)
End If
'' 再接続を行わない
GB_TmBusyFlag = True
.Cells(1, 1).Value = "□"
.Cells(1, 1).Font.Color = RGB(0, 0, 0)
End If
End With
DoEvents
End Sub