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