NonSoft

EXCEL通信テスト(RS232C/TCPIP/UDPIP)


 ダウンロード

EXCEL(VBA)を使用した簡単!! 通信テスト!! 対象プロトコルはRS232C、TCP/IP、UDP/IP!!

ダウンロード  画面イメージ 
RS232CのVBAサンプル  TCP/IPのVBAサンプル  UDP/IPのVBAサンプル 

その他の通信ツールはこちらです。通信ツール(RS232C TCP/IP UDP/IP)
====================================================================================================
【タイトル     】EXCEL通信テスト(RS232C/TCPIP/UDPIP)
【Version      】3.0.0.8
【ファイル     】ExcelComTest.zip
【圧縮ファイルの中身】Rs232cTest.xls (RS232C用のEXCEL通信テスト) EXCEL VBAのサンプルソース
【圧縮ファイルの中身】TcpIpCTest.xls (TCP/IP用のEXCEL通信テスト) EXCEL VBAのサンプルソース(Client)
【圧縮ファイルの中身】TcpIpSTest.xls (TCP/IP用のEXCEL通信テスト) EXCEL VBAのサンプルソース(Server)
                      ★★新着★★複数クライアント対応TCP/IPサーバー(TcpIpSTest2.xls)
【圧縮ファイルの中身】UdpIpTest.xls  (UDP/IP用のEXCEL通信テスト) EXCEL VBAのサンプルソース
【圧縮ファイルの中身】NonComSck.ocx  (RS232C、TCP/IP、UDP/IP用のOCX)
【圧縮ファイルの中身】Rs232cTool.exe (RS232C用の評価ツール)
【圧縮ファイルの中身】TcpIpTool.exe  (TCP/IP用の評価ツール)
【圧縮ファイルの中身】UdpIpTool.exe  (UDP/IP用の評価ツール)
【圧縮ファイルの中身】ReadMe.txt
【必要ソフト   (1)】MSCOMM32.OCXが入っているVB6ランタイム(RS232Cの時)
【必要ソフト   (2)】MSWINSCK.OCXが入っているVB6ランタイム(TCP/IPまたはUDP/IPの時)
【必要ソフト   (3)】EXCEL2000、EXCEL2003およびEXCEL2010で動作確認
【動作確認     】Windows8/Windows7/XP/2000
【ソフト種別    】フリーソフト(寄付歓迎)
【作者/著作権者  】のん
【作者への連絡先  】http://nonsoft.la.coocan.jp/
====================================================================================================
1.はじめに
  本プログラムをダウンロード頂きまして誠にありがとうございます。
  本プログラムは、エクセルを使用して電文の送受信テストを行なう通信テストツールです。
  3つの通信プロトコル(RS232C、TCP/IP、UDP/IP)の通信テストが出来ます。
  EXCEL VBAで記述していますのでサンプルソースとしてもお試し頂けます。
  <主な機能>
  1.ポート接続(オープン)
  2.ポート切断(クローズ)
  3.データ送信(文字列送信/バイナリ(HEX指定)送信)
  4.データ受信(文字列表示/バイナリ(HEX指定)表示)

  ※RS232Cの場合はDTR/RTSの制御およびDSR/CTSの確認を行う事が出来ます。
  ※EXCEL通信テスト(RS232C/TCPIP/UDPIP)を評価するためのツールも同梱しています。

  <関連ツール>
  スクリプト通信テスト(RS232C/TCPIP/UDPIP)  ※VBS(Windows標準WSH)で通信プログラミング
  スクリプト(VBS)を使用した簡単!! 通信テスト!! 対象プロトコルはRS232C、TCP/IP、UDP/IP!!
  仮想シリアル(COMポート)ドライバ           ※仮想(ボード無! コネクタ無! ケーブル無!)
  2つの仮想COMポート(RS232Cシリアル)をクロスケーブルで接続したように通信するドライバ!!

2.インストール方法/アンインストール方法
  事前に管理者として次のコマンド実行してください (参照)"事前に実行してください.bat"
  regsvr32.exe "NONCOMSCK.OCX" (注意)"NONCOMSCK.OCX"をフルPATHで指定してください

  本プログラム一式を削除(アンインストール)する際は、
  管理者として次のコマンドを実行してください。
  regsvr32.exe /u "NONCOMSCK.OCX"

  (注意)64bit(x64)版のEXCELで本VBAソースを実行するとCreateObjectでエラーが発生します。

3.著作権・ライセンス
  本プログラムの全ての著作権は「のん」が所有しています。本プログラム一式を転載する場合は著作権所有
  者の許可が必要となります。(NonSoft の紹介リンクは問題ありませんので宜しくお願いします)また、著作
  権所有者が許可したサイトでのみダウンロードが可能となります。商用利用についての制限はありません。

  本プログラムはフリーライセンス(寄付歓迎)です。
  本プログラムを長期間使用される場合は、寄付やホームページ紹介等をしてください。
  寄付はこちらでお願いします。http://nonsoft.la.coocan.jp/kifu.html

4.免責事項
  本プログラムが原因による損害・問題に対し一切の責任を負えません。
  ご利用者の責任の範囲内でお使いください。

5.作者への問合せについて
  作者への問合せはメールのみとさせて頂きます。問合せ内容によっては回答出来ない場合もございますので
  予めご了承願います。また、作者不在時または問い合わせ数が多い場合など、回答に日数がかかる場合がご
  ざいますので予めご了承願います。

<画面イメージ>

EXCEL通信テスト(RS232C/TCPIP/UDPIP)の実行イメージ
<RS232CのVBAサンプル>
Option Explicit
'****************************************************************************
' 機能名    : EXCEL通信テスト(RS232C)
' 機能説明  : EXCELを使用したRS232Cの通信テストツール
' 著作権    : Copyright(C) 2010 のん All rights reserved
' URL    : http://nonsoft.la.coocan.jp/
'           : このソースを使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このソースを参考にした旨を記述
'           : してください。(例)WEBページやReadMeにURLのリンクを貼る等
' 動作環境  : MSCOMM32.OCXが入っているVB6ランタイムが必要です。
'           : 事前に"regsvr32 NONCOMSCK.OCX"を実行してください。
'****************************************************************************

' NONCOMSCK.OCXを参照設定しています
Private WithEvents MSComm1 As NonComSck.MSComm

' 受信データ表示行番号
Private InputRow As Long

' COMポートオープン
Private Sub Btn_Open_Click()
    ' COMポートオープンチェック
    If MSComm1 Is Nothing = False Then
        If MSComm1.PortOpen = True Then
            MsgBox "既にCOMポートがオープンされています"
            Exit Sub
        End If
    End If
    
    ' 受信データ表示カラムをクリア
    Sheet1.Range("B15:B999") = ""

    ' 受信データ表示行番号初期化
    InputRow = 15
    
    ' COMポートオープン情報取得
    Dim prt As String: prt = Sheet1.Cells(5, 4)
    Dim spd As String: spd = Sheet1.Cells(7, 4)
    Dim pri As String: pri = Sheet1.Cells(9, 4)
    Dim bit As String: bit = Sheet1.Cells(11, 4)
    Dim stp As String: stp = Sheet1.Cells(13, 4)
    
    ' COMポートのオープン
    Set MSComm1 = CreateObject("NonComSck.MSComm")
    MSComm1.Settings = spd & "," & pri & "," & bit & "," & stp
    MSComm1.CommPort = prt
    MSComm1.PortOpen = True
    
    ' DTR、RTSの初期設定
    MSComm1.DTREnable = Chk_DTR.Value
    MSComm1.RTSEnable = Chk_RTS.Value

    ' CTS、DSRの初期確認
    Chk_CTS.Value = MSComm1.CTSHolding
    Chk_DSR.Value = MSComm1.DSRHolding

    ' COMポート受信イベント作成
    MSComm1.RThreshold = 1
End Sub

' COMポートクローズ
Private Sub Btn_Close_Click()
    ' COMポートオープンチェック
    If MSComm1 Is Nothing Then
        MsgBox "COMポートがオープンされていません"
        Exit Sub
    ElseIf MSComm1.PortOpen = False Then
        MsgBox "COMポートがオープンされていません"
        Exit Sub
    End If
    
    ' COMポートのクローズ
    MSComm1.PortOpen = False
    Set MSComm1 = Nothing
End Sub

' COMポートへデータ送信
Private Sub Btn_Send_Click()
    ' COMポートオープンチェック
    If MSComm1 Is Nothing Then
        MsgBox "COMポートがオープンされていません"
        Exit Sub
    ElseIf MSComm1.PortOpen = False Then
        MsgBox "COMポートがオープンされていません"
        Exit Sub
    End If
    
    ' 選択したセルのデータを送信データとする
    Dim sdat As String
    If ActiveCell.Row >= 4 And ActiveCell.Column >= 2 And _
       ActiveCell.Row <= 13 And ActiveCell.Column <= 4 Then
        sdat = Sheet1.Cells(ActiveCell.Row, ActiveCell.Column)
    End If
    
    If sdat <> "" Then
        If Sheet1.Chk_SHex.Value = True Then
            ' 送信データをHEXコードから文字列に変換--ここから--
            On Error Resume Next
            Dim i As Long
            ReDim shex(Int((Len(sdat) + 1) / 2) - 1) As Byte
            For i = 0 To Len(sdat) - 1 Step 2
                shex(i / 2) = "&H" & Mid$(sdat, i + 1, 2)
            Next i
            On Error GoTo 0
            ' 送信データをHEXコードから文字列に変換--ここまで--
            
            ' COMポートにデータ送信
            MSComm1.Output = shex
        Else
            ' COMポートにデータ送信
            MSComm1.Output = sdat
        End If
    Else
        MsgBox "送信データ(セル)を選択してください。"
    End If
End Sub

' COMポートからデータ受信
Private Sub MSComm1_OnComm()
    ' COMポートオープンチェック
    If MSComm1 Is Nothing Then
        'MsgBox "COMポートがオープンされていません"
        Exit Sub
    ElseIf MSComm1.PortOpen = False Then
        'MsgBox "COMポートがオープンされていません"
        Exit Sub
    End If
    
    ' COMポートからデータ受信
    If MSComm1.CommEvent = comEvReceive Then
        Dim rdat As String: rdat = ""
        If Sheet1.Chk_RHex.Value = True Then
            ' COMポートからデータ受信
            Dim rhex() As Byte
            MSComm1.InputMode = comInputModeBinary
            rhex = MSComm1.Input2
            
            ' 受信データをHEXコードに変換--ここから----------------
            Dim i As Long
            For i = 0 To UBound(rhex)
                Dim str As String
                str = "00" & Hex(rhex(i))
                rdat = rdat & Right$(str, 2)
            Next i
            ' 受信データをHEXコードに変換--ここまで----------------
        Else
            ' COMポートからデータ受信
            MSComm1.InputMode = comInputModeText
            rdat = MSComm1.Input2
        End If
        
        ' 受信データ表示セルに受信データを表示
        rdat = Replace$(rdat, Chr(0), "")
        Sheet1.Cells(InputRow, 2) = "" & rdat
        InputRow = InputRow + 1
    End If
    Chk_CTS.Value = MSComm1.CTSHolding
    Chk_DSR.Value = MSComm1.DSRHolding
End Sub

' COMポートへDTR設定
Private Sub Chk_DTR_Click()
    ' COMポートオープンチェック
    If MSComm1 Is Nothing Then
        Exit Sub
    ElseIf MSComm1.PortOpen = False Then
        Exit Sub
    End If
    MSComm1.DTREnable = Chk_DTR.Value
End Sub

' COMポートへRTS設定
Private Sub Chk_RTS_Click()
    ' COMポートオープンチェック
    If MSComm1 Is Nothing Then
        Exit Sub
    ElseIf MSComm1.PortOpen = False Then
        Exit Sub
    End If
    MSComm1.RTSEnable = Chk_RTS.Value
End Sub

' 送信データ選択カラム変更
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Sheet1.Unprotect
    Sheet1.Range("B4:C13").Font.ColorIndex = 0
    If Target.Cells.Row >= 4 And Target.Cells.Row <= 13 And _
       Target.Cells.Column >= 2 And Target.Cells.Column <= 3 Then
        Target.Font.ColorIndex = 3
    End If
    Sheet1.Protect
End Sub

<TCP/IP(クライアント)のVBAサンプル>
Option Explicit
'****************************************************************************
' 機能名    : EXCEL通信テスト(TCP/IPクライアント)
' 機能説明  : EXCELを使用したTCP/IPの通信テストツール
' 著作権    : Copyright(C) 2010 のん All rights reserved
' URL    : http://nonsoft.la.coocan.jp/
'           : このソースを使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このソースを参考にした旨を記述
'           : してください。(例)WEBページやReadMeにURLのリンクを貼る等
' 動作環境  : MSWINSCK.OCXが入っているVB6ランタイムが必要です。
'           : 事前に"regsvr32 NONCOMSCK.OCX"を実行してください。
'****************************************************************************

' NONCOMSCK.OCXを参照設定しています
Private WithEvents Winsock1 As NonComSck.Winsock

' 受信データ表示行番号
Private InputRow As Long

' ソケット(TCPIP)接続
Private Sub Btn_Open_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing = False Then
        MsgBox "既にソケット(TCPIP)が接続されています"
        Exit Sub
    End If
    
    ' 受信データ表示カラムをクリア
    Sheet1.Range("B15:B999") = ""

    ' 受信データ表示行番号初期化
    InputRow = 15
    
    ' ソケット(TCPIP)接続情報取得
    Dim ip As String: ip = Sheet1.Cells(5, 4)
    Dim pt As String: pt = Sheet1.Cells(7, 4)
    
    ' ソケット(TCPIP)接続
    Set Winsock1 = CreateObject("NonComSck.Winsock")
    Winsock1.Connect ip, pt
    
    ' ソケット(TCPIP)接続
    Do While Winsock1.State = sckConnecting
        DoEvents
    Loop
    
    ' ソケット(TCPIP)接続エラーチェック
    If Winsock1.State = sckClosed Or Winsock1.State = sckError Then
        Winsock1.Close2
        Set Winsock1 = Nothing
        MsgBox "ソケット(TCPIP)に接続出来ませんでした"
    End If
End Sub

' ソケット(TCPIP)切断
Private Sub Btn_Close_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    ' ソケット(TCPIP)切断
    Winsock1.Close2
    Set Winsock1 = Nothing
End Sub

' ソケット(TCPIP)へデータ送信
Private Sub Btn_Send_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    If Winsock1.State <> sckConnected Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    ' 選択したセルのデータを送信データとする
    Dim sdat As String
    If ActiveCell.Row >= 4 And ActiveCell.Column >= 2 And _
       ActiveCell.Row <= 13 And ActiveCell.Column <= 4 Then
        sdat = Sheet1.Cells(ActiveCell.Row, ActiveCell.Column)
    End If
    
    If sdat <> "" Then
        If Sheet1.Chk_SHex.Value = True Then
            ' 送信データをHEXコードから文字列に変換--ここから--
            On Error Resume Next
            Dim i As Long
            ReDim shex(Int((Len(sdat) + 1) / 2) - 1) As Byte
            For i = 0 To Len(sdat) - 1 Step 2
                shex(i / 2) = "&H" & Mid$(sdat, i + 1, 2)
            Next i
            On Error GoTo 0
            ' 送信データをHEXコードから文字列に変換--ここまで--
            
            ' ソケット(TCPIP)にデータ送信
            Winsock1.SendData shex
        Else
            ' ソケット(TCPIP)にデータ送信
            Winsock1.SendData sdat
        End If
    Else
        MsgBox "送信データ(セル)を選択してください。"
    End If
End Sub

' ソケット(TCPIP)からデータ受信
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        'MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    Dim rdat As String: rdat = ""
    If Sheet1.Chk_RHex.Value = True Then
        ' ソケット(TCPIP)からデータ受信
        Dim rhex() As Byte
        Winsock1.GetData rhex
        
        ' 受信データをHEXコードに変換--ここから----------------
        Dim i As Long
        For i = 0 To UBound(rhex)
            Dim str As String
            str = "00" & Hex(rhex(i))
            rdat = rdat & Right$(str, 2)
        Next i
        ' 受信データをHEXコードに変換--ここまで----------------
    Else
        ' ソケット(TCPIP)からデータ受信
        Winsock1.GetData rdat
    End If

    ' 受信データ表示セルに受信データを表示
    rdat = Replace$(rdat, Chr(0), "")
    Sheet1.Cells(InputRow, 2) = "" & rdat
    InputRow = InputRow + 1
End Sub

' 送信データ選択カラム変更
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Sheet1.Unprotect
    Sheet1.Range("B4:C13").Font.ColorIndex = 0
    If Target.Cells.Row >= 4 And Target.Cells.Row <= 13 And _
       Target.Cells.Column >= 2 And Target.Cells.Column <= 3 Then
        Target.Font.ColorIndex = 3
    End If
    Sheet1.Protect
End Sub

<TCP/IP(サーバ)のVBAサンプル>
Option Explicit
'****************************************************************************
' 機能名    : EXCEL通信テスト(TCP/IPサーバ)
' 機能説明  : EXCELを使用したTCP/IPの通信テストツール
' 著作権    : Copyright(C) 2010 のん All rights reserved
' URL    : http://nonsoft.la.coocan.jp/
'           : このソースを使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このソースを参考にした旨を記述
'           : してください。(例)WEBページやReadMeにURLのリンクを貼る等
' 動作環境  : MSWINSCK.OCXが入っているVB6ランタイムが必要です。
'           : 事前に"regsvr32 NONCOMSCK.OCX"を実行してください。
'****************************************************************************

' NONCOMSCK.OCXを参照設定しています
Private WithEvents Winsock1 As NonComSck.Winsock

' 受信データ表示行番号
Private InputRow As Long

' ソケット(TCPIP)接続およびクライアントからの接続待ち
Private Sub Btn_Open_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing = False Then
        MsgBox "既にソケット(TCPIP)が接続されています"
        Exit Sub
    End If
    
    ' 受信データ表示カラムをクリア
    Sheet1.Range("B15:B999") = ""

    ' 受信データ表示行番号初期化
    InputRow = 15
    
    ' ソケット(TCPIP)接続情報取得
    Dim lo As String: lo = Sheet1.Cells(5, 4)
    
    ' ソケット(TCPIP)接続およびクライアントからの接続待ち
    Set Winsock1 = CreateObject("NonComSck.Winsock")
    Winsock1.Close2
    Winsock1.LocalPort = lo
    Winsock1.Listen
End Sub

' ソケット(TCPIP)切断
Private Sub Btn_Close_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    ' ソケット(TCPIP)切断
    Winsock1.Close2
    Set Winsock1 = Nothing
End Sub

' クライアントからの接続
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    ' 複数クライアントとの接続を行なわない仕様
    Winsock1.Close2
    ' クライアントからの接続を許可
    Winsock1.Accept requestID
End Sub

' クライアントからの切断
Private Sub Winsock1_Close()
    ' ソケット(TCPIP)接続情報取得
    Dim lo As String: lo = Sheet1.Cells(5, 4)
    
    ' ソケット(TCPIP)接続およびクライアントからの接続待ち
    Winsock1.Close2
    Winsock1.LocalPort = lo
    Winsock1.Listen
End Sub

' ソケット(TCPIP)へデータ送信
Private Sub Btn_Send_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    If Winsock1.State <> sckConnected Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    ' 選択したセルのデータを送信データとする
    Dim sdat As String
    If ActiveCell.Row >= 4 And ActiveCell.Column >= 2 And _
       ActiveCell.Row <= 13 And ActiveCell.Column <= 4 Then
        sdat = Sheet1.Cells(ActiveCell.Row, ActiveCell.Column)
    End If
    
    If sdat <> "" Then
        If Sheet1.Chk_SHex.Value = True Then
            ' 送信データをHEXコードから文字列に変換--ここから--
            On Error Resume Next
            Dim i As Long
            ReDim shex(Int((Len(sdat) + 1) / 2) - 1) As Byte
            For i = 0 To Len(sdat) - 1 Step 2
                shex(i / 2) = "&H" & Mid$(sdat, i + 1, 2)
            Next i
            On Error GoTo 0
            ' 送信データをHEXコードから文字列に変換--ここまで--
            
            ' ソケット(TCPIP)にデータ送信
            Winsock1.SendData shex
        Else
            ' ソケット(TCPIP)にデータ送信
            Winsock1.SendData sdat
        End If
    Else
        MsgBox "送信データ(セル)を選択してください。"
    End If
End Sub

' ソケット(TCPIP)からデータ受信
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        'MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    Dim rdat As String: rdat = ""
    If Sheet1.Chk_RHex.Value = True Then
        ' ソケット(TCPIP)からデータ受信
        Dim rhex() As Byte
        Winsock1.GetData rhex
        
        ' 受信データをHEXコードに変換--ここから----------------
        Dim i As Long
        For i = 0 To UBound(rhex)
            Dim str As String
            str = "00" & Hex(rhex(i))
            rdat = rdat & Right$(str, 2)
        Next i
        ' 受信データをHEXコードに変換--ここまで----------------
    Else
        ' ソケット(TCPIP)からデータ受信
        Winsock1.GetData rdat
    End If

    ' 受信データ表示セルに受信データを表示
    rdat = Replace$(rdat, Chr(0), "")
    Sheet1.Cells(InputRow, 2) = "" & rdat
    InputRow = InputRow + 1
End Sub

' 送信データ選択カラム変更
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Sheet1.Unprotect
    Sheet1.Range("B4:C13").Font.ColorIndex = 0
    If Target.Cells.Row >= 4 And Target.Cells.Row <= 13 And _
       Target.Cells.Column >= 2 And Target.Cells.Column <= 3 Then
        Target.Font.ColorIndex = 3
    End If
    Sheet1.Protect
End Sub

<UDP/IPのVBAサンプル>
Option Explicit
'****************************************************************************
' 機能名    : EXCEL通信テスト(UDP/IP)
' 機能説明  : EXCELを使用したUDP/IPの通信テストツール
' 著作権    : Copyright(C) 2010 のん All rights reserved
' URL    : http://nonsoft.la.coocan.jp/
'           : このソースを使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このソースを参考にした旨を記述
'           : してください。(例)WEBページやReadMeにURLのリンクを貼る等
' 動作環境  : MSWINSCK.OCXが入っているVB6ランタイムが必要です。
'           : 事前に"regsvr32 NONCOMSCK.OCX"を実行してください。
'****************************************************************************

' NONCOMSCK.OCXを参照設定しています
Private WithEvents Winsock1 As NonComSck.Winsock

' 受信データ表示行番号
Private InputRow As Long

' ソケット(UDPIP)接続
Private Sub Btn_Open_Click()
    ' ソケット(UDPIP)接続チェック
    If Winsock1 Is Nothing = False Then
        MsgBox "既にソケット(UDPIP)が接続されています"
        Exit Sub
    End If
    
    ' 受信データ表示カラムをクリア
    Sheet1.Range("B15:B999") = ""

    ' 受信データ表示行番号初期化
    InputRow = 15
    
    ' ソケット(UDPIP)接続情報取得
    Dim ip As String: ip = Sheet1.Cells(5, 4)
    Dim pt As String: pt = Sheet1.Cells(7, 4)
    Dim lo As String: lo = Sheet1.Cells(9, 4)
    
    ' ソケット(UDPIP)接続
    Set Winsock1 = CreateObject("NonComSck.Winsock")
    Winsock1.Protocol = sckUDPProtocol
    Winsock1.RemoteHost = ip
    Winsock1.RemotePort = pt
    Winsock1.Bind lo
End Sub

' ソケット(UDPIP)切断
Private Sub Btn_Close_Click()
    ' ソケット(UDPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(UDPIP)が接続されていません"
        Exit Sub
    End If
    
    ' ソケット(UDPIP)切断
    Winsock1.Close2
    Set Winsock1 = Nothing
End Sub

' ソケット(UDPIP)へデータ送信
Private Sub Btn_Send_Click()
    ' ソケット(UDPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(UDPIP)が接続されていません"
        Exit Sub
    End If
    
    ' 選択したセルのデータを送信データとする
    Dim sdat As String
    If ActiveCell.Row >= 4 And ActiveCell.Column >= 2 And _
       ActiveCell.Row <= 13 And ActiveCell.Column <= 4 Then
        sdat = Sheet1.Cells(ActiveCell.Row, ActiveCell.Column)
    End If
    
    If sdat <> "" Then
        If Sheet1.Chk_SHex.Value = True Then
            ' 送信データをHEXコードから文字列に変換--ここから--
            On Error Resume Next
            Dim i As Long
            ReDim shex(Int((Len(sdat) + 1) / 2) - 1) As Byte
            For i = 0 To Len(sdat) - 1 Step 2
                shex(i / 2) = "&H" & Mid$(sdat, i + 1, 2)
            Next i
            On Error GoTo 0
            ' 送信データをHEXコードから文字列に変換--ここまで--
            
            ' ソケット(UDPIP)にデータ送信
            Winsock1.SendData shex
        Else
            ' ソケット(UDPIP)にデータ送信
            Winsock1.SendData sdat
        End If
    Else
        MsgBox "送信データ(セル)を選択してください。"
    End If
End Sub

' ソケット(UDPIP)からデータ受信
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    ' ソケット(UDPIP)接続チェック
    If Winsock1 Is Nothing Then
        'MsgBox "ソケット(UDPIP)が接続されていません"
        Exit Sub
    End If
    
    Dim rdat As String: rdat = ""
    If Sheet1.Chk_RHex.Value = True Then
        ' ソケット(UDPIP)からデータ受信
        Dim rhex() As Byte
        Winsock1.GetData rhex
        
        ' 受信データをHEXコードに変換--ここから----------------
        Dim i As Long
        For i = 0 To UBound(rhex)
            Dim str As String
            str = "00" & Hex(rhex(i))
            rdat = rdat & Right$(str, 2)
        Next i
        ' 受信データをHEXコードに変換--ここまで----------------
    Else
        ' ソケット(UDPIP)からデータ受信
        Winsock1.GetData rdat
    End If

    ' 受信データ表示セルに受信データを表示
    rdat = Replace$(rdat, Chr(0), "")
    Sheet1.Cells(InputRow, 2) = "" & rdat
    InputRow = InputRow + 1
End Sub

' 送信データ選択カラム変更
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Sheet1.Unprotect
    Sheet1.Range("B4:C13").Font.ColorIndex = 0
    If Target.Cells.Row >= 4 And Target.Cells.Row <= 13 And _
       Target.Cells.Column >= 2 And Target.Cells.Column <= 3 Then
        Target.Font.ColorIndex = 3
    End If
    Sheet1.Protect
End Sub