オシロスコープをExcelで制御して測定値とスクリーンショットを取得する

1.はじめに

この記事はArduinoとオシロスコープをExcelで制御して測定する(2) シャッタースピードの自動測定の続編です。

オシロスコープに :DISPlay:DATA? コマンドを発行してスクリーンショットの画像データを取得できるよう上記記事のプログラムの ControlDSO() 関数を改修しました。

2.動作

あらかじめオシロスコープのCH1にプローブ補償信号（1kHzの矩形波信号）を入力して動作させたときの例を以下に示します。

• A列（制御対象機器）、B列（送信データ）、C列（受信データ）の3列でワンセットです。
  • A列が DSO となっている行はオシロスコープへB列のデータを送信し、受信したデータをC列へ格納します。
• 13行目はオシロスコープに *IDN? コマンドを送信し、C13セルに受信データが格納されています。
• 14行目はオシロスコープに :MEASure:ITEM? FREQ, CHAN1 コマンドを送信し、C14セルに測定結果（1000Hz）が格納されています。
• 15行目はオシロスコープに :DISPlay:DATA? ON,0,PNG コマンドを送信し、C15セルに受信したスクリーンショットが格納されています。
  • セルの高さに合うように縦横比を保って縮小しています。

セルに貼り付けられたスクリーンショットは、画像を選択して右クリック → サイズとプロパティ(Z)... → 図の書式設定 → リセット押下 で縮小前のサイズになります。もとに戻すときはCtrl-zでアンドゥします。

また、Excelファイルと同じフォルダに「ファイル名-シート名-貼り付け先のセル座標.png」というファイル名でスクリーンショットを保存します。Excelファイルを移動する際は画像ファイルも一緒に移動してください。

3.応用例

実際の測定では同じ測定を繰り返して最大値や最小値、平均値、ばらつきなどを求めることと思います。測定しながらスクリーンショットも取得する例を以下に示します。

• 12行目でLOOPの回数を5に設定します。
• 20行目～空白行の手前（例では26行目）までを繰り返します。
• 21行目でExcelのメッセージダイアログを表示します。
  • 動作確認を兼ねて水平軸のスケールを変更してからOKを押下しています。
• 22行目でオシロスコープへ :SINGLE コマンドを送信します。
• 23行目でトリガがかかるまでの待ち時間を適当に入れます。
• 24行目でF10セル～H10セルのコマンドを実行します。
• 25行目でI10セル～K10セルのコマンドを実行します。
• 26行目はコメント行です。次の行が空白のため20行目に戻って繰り返します。
• 以後、24行目と25行目はF列～H列、I列～K列のコマンドを一行ずつインクリメントしながら実行します。

GPIB-DispData-DispData2-10-11.png～GPIB-DispData-DispData2-14-11.pngの5個のスクリーンショット画像も保存されました。

4.ソースコード（ControlDSO関数）

ソースコード全文は付録Cをご覧ください。

• 送信コマンド（strTxd）に :DISPlay:DATA? が含まれるとif文内に分岐します。
• スクリーンショットの画像ファイル名はimgFileName変数に入れています。拡張子を.pngに決め打ちしていますのでPNG形式を指定して:DISPlay:DATA?コマンドを送信してください。
• スクリーンショットのデータはVISAライブラリのReadIEEEBlock()で読み出します。
• 読み出したデータをバイナリ形式でファイルに保存します。
• Excelのシートへの画像貼りつけはファイルに保存した画像ファイルを挿入しています。

'line:送信データが記述されているセルの行番号
'strTxd:送信データ
'colRxd:受信データの格納先セルの列番号
Function ControlDSO(line As Long, strTxd As String, colRxd As Long)
    Dim visaAddr As String
    visaAddr = ActiveSheet.Range(VISA_ADDR_DSO)
    
    Dim RM As New VisaComLib.ResourceManager
    Dim DSO As New VisaComLib.FormattedIO488
    
    Set DSO.IO = RM.Open(visaAddr)
    DSO.WriteString strTxd
    
    If InStr(strTxd, ":DISPlay:DATA?") > 0 Then
        Dim filePath As String
        filePath = ThisWorkbook.Path
        
        Dim fileName As String
        fileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
        
        Dim sheetName As String
        sheetName = ActiveSheet.Name
        
        Dim imgFileName As String
        imgFileName = filePath + "\" + fileName + "-" + sheetName + "-" + CStr(line) + "-" + CStr(colRxd) + ".png"
        
        Dim freeFileNum As Long
        freeFileNum = FreeFile
        
        Dim binData() As Byte
        binData = DSO.ReadIEEEBlock(BinaryType_UI1)
        
        Open imgFileName For Binary As #freeFileNum
                Put #freeFileNum, , binData
        Close #freeFileNum
        
        With ActiveSheet.Pictures.Insert(imgFileName)
            .Top = Cells(line, colRxd).Top
            .Left = Cells(line, colRxd).Left
            .Height = Cells(line, colRxd).Height
        End With
    
    ElseIf InStr(strTxd, "?") > 0 Then
        ActiveSheet.Cells(line, colRxd) = Replace(DSO.ReadString(), vbLf, "")
    End If
    
    DSO.IO.Close
    Set DSO = Nothing
    Set RM = Nothing
End Function

5.おわりに

測定値に加えてスクリーンショットも自動でシートに記録できるようになりました。USBメモリを介さずにスクリーンショットを取得できるのは便利ですね。

付録A.参考資料

• RIGOL MSO5000 オシロをPythonから制御する
• [プログラミング]Infiniiumを使っていますが、オシロの画面をPCに取り込むコマンドはありますか？ - Technical Support Knowledge Center Open
• データをバイナリ形式で保存する: VBAでExcelを操作しよう
• Office TANAKA - Excel VBA Tips[画像を挿入する]

付録B.動作確認環境

• Windows 10 64bit 21H1
• Excel 2016 MSO (バージョン 2202 ビルド 16.0.14931.20118) 32bit
• VISA-COM 5.9 Type Library
  • Keysight IO Libraries Suite 2018 Update 0.2に同梱されているもの
• RIGOL DS1104Z

付録C.ソースコード一式

10行目のLINE_PARSER_LOOPの値を変えると繰り返し実行の開始行を変えることができます。

Option Explicit

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

Const COL_PARSER_CMD = 1     'A列：パーサ用コマンドカラム
Const COL_PARSER_TXD = 2     'B列：パーサ用送信データカラム
Const COL_PARSER_RXD = 3     'C列：パーサ用受信データカラム

Const LINE_PARSER_START = 10 'パーサ用コマンド開始行
Const LINE_PARSER_LOOP = 20  'パーサ用ループ処理開始行

Const LINE_TABLE_START = 10  '測定テーブル用コマンド開始行

Const VISA_ADDR_DSO = "C6"   'DSO : Digital Storage Oscilloscope
Const VISA_ADDR_TB = "C7"    'TB  : Target Board

'「テスト開始」ボタン押下で呼出すマクロ
Sub Parser()
    Dim i As Long
    Dim loopNum As Long
    Dim loopNumMax As Long
    loopNumMax = 1           'いったん1で設定(LOOPコマンドで上書き可)

    Dim strCmd As String
    Dim strTxd As String

    loopNum = 0
    Do While loopNum < loopNumMax

        i = LINE_PARSER_START
        Do While ActiveSheet.Cells(i, COL_PARSER_CMD) <> ""

            If loopNum >= 1 And i < LINE_PARSER_LOOP Then
                '処理をスキップする

            Else
                ActiveSheet.Cells(i, COL_PARSER_CMD).Select

                strCmd = ActiveSheet.Cells(i, COL_PARSER_CMD)
                strTxd = ActiveSheet.Cells(i, COL_PARSER_TXD)

                If InStr(strCmd, "//") > 0 Then
                    '何もしない
                ElseIf strCmd = "DSO" Then
                    Call ControlDSO(i, strTxd, COL_PARSER_RXD)

                ElseIf strCmd = "TB" Then
                    Call ControlTB(i, strTxd, COL_PARSER_RXD)

                ElseIf strCmd = "SYS" Then
                    Call SysControl(strTxd)

                ElseIf strCmd = "WAITMS" Then
                    Call SysWaitMs(strTxd)

                ElseIf strCmd = "MSGBOX" Then
                    MsgBox (strTxd)

                ElseIf strCmd = "LOOP" Then
                    If IsNumeric(strTxd) = True Then
                        loopNumMax = CInt(strTxd)
                    Else
                        MsgBox ("unknown value")
                    End If

                ElseIf strCmd = "TABLE" Then
                    Call SysTable(loopNum, strTxd)

                Else
                    MsgBox ("unknown command")

                End If

            End If

            i = i + 1
        Loop

        loopNum = loopNum + 1
    Loop

End Sub

Function SysTable(loopNum As Long, colTable As String)
    Dim i As Long
    Dim column As Long
    Dim strCmd As String
    Dim strTxd As String

    i = loopNum + LINE_TABLE_START

    column = Range(colTable + "1").column
    ActiveSheet.Cells(i, column).Select

    strCmd = ActiveSheet.Cells(i, column)
    strTxd = ActiveSheet.Cells(i, column + 1)

    If strCmd = "DSO" Then
        Call ControlDSO(i, strTxd, column + 2)

    ElseIf strCmd = "TB" Then
        Call ControlTB(i, strTxd, column + 2)

    End If

    i = i + 1

End Function

'line:送信データが記述されているセルの行番号
'strTxd:送信データ
'colRxd:受信データの格納先セルの列番号
Function ControlDSO(line As Long, strTxd As String, colRxd As Long)
    Dim visaAddr As String
    visaAddr = ActiveSheet.Range(VISA_ADDR_DSO)
    
    Dim RM As New VisaComLib.ResourceManager
    Dim DSO As New VisaComLib.FormattedIO488
    
    Set DSO.IO = RM.Open(visaAddr)
    DSO.WriteString strTxd
    
    If InStr(strTxd, ":DISPlay:DATA?") > 0 Then
        Dim filePath As String
        filePath = ThisWorkbook.Path
        
        Dim fileName As String
        fileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
        
        Dim sheetName As String
        sheetName = ActiveSheet.Name
        
        Dim imgFileName As String
        imgFileName = filePath + "\" + fileName + "-" + sheetName + "-" + CStr(line) + "-" + CStr(colRxd) + ".png"
        
        Dim freeFileNum As Long
        freeFileNum = FreeFile
        
        Dim binData() As Byte
        binData = DSO.ReadIEEEBlock(BinaryType_UI1)
        
        Open imgFileName For Binary As #freeFileNum
                Put #freeFileNum, , binData
        Close #freeFileNum
        
        With ActiveSheet.Pictures.Insert(imgFileName)
            .Top = Cells(line, colRxd).Top
            .Left = Cells(line, colRxd).Left
            .Height = Cells(line, colRxd).Height
        End With
    
    ElseIf InStr(strTxd, "?") > 0 Then
        ActiveSheet.Cells(line, colRxd) = Replace(DSO.ReadString(), vbLf, "")
    End If
    
    DSO.IO.Close
    Set DSO = Nothing
    Set RM = Nothing
End Function

Function ControlTB(line As Long, strTxd As String, colRxd As Long)
    Dim i As Long
    Dim j As Long
    Dim strVal As String
    Dim strArray() As String
'    Dim dbgStr As String

    Dim visaAddr As String
    visaAddr = ActiveSheet.Range(VISA_ADDR_TB)

    Dim RM As New VisaComLib.ResourceManager
    Dim TB As New VisaComLib.FormattedIO488  'TB : Target Board

    Set TB.IO = RM.Open(visaAddr)
    Dim sfc As VisaComLib.ISerial            'RS232C通信設定
    Set sfc = TB.IO
    sfc.BaudRate = 9600
    sfc.DataBits = 8
    sfc.Parity = ASRL_PAR_NONE
    sfc.StopBits = ASRL_STOP_ONE
    sfc.FlowControl = ASRL_FLOW_NONE

    TB.IO.TerminationCharacter = 10
    TB.IO.TerminationCharacterEnabled = True

    TB.WriteString strTxd

    strVal = ""
    For i = 1 To 3                           'Write→ReadのあいだにSleepを入れる
        Sleep (10)
        DoEvents

        strVal = strVal + TB.ReadString()
        ReDim strArray(1 To Len(strVal))

        For j = 1 To UBound(strArray)        '制御文字を削除する
            strArray(j) = Mid(strVal, j, 1)
            If Asc(strArray(j)) <= 31 Or 127 <= Asc(strArray(j)) Then
'                dbgStr = CStr(i) + "," + CStr(j) + "," + CStr(Asc(strArray(j)))
'                MsgBox (dbgStr)
                strArray(j) = ""
            End If
        Next j
        strVal = Join(strArray, "")

        If i <= 2 Then
            strVal = strVal + "/"
        End If

        If strVal <> "" Then
            ActiveSheet.Cells(line, colRxd).Value = strVal
            'Exit For
        End If
    Next

    TB.IO.Close
    Set TB = Nothing
    Set RM = Nothing
End Function

Function SysWaitMs(waitMs As String)
    Dim i As Long
    Dim loopNum As Long

    If IsNumeric(waitMs) = True Then
        loopNum = CInt(waitMs) / 100
        For i = 1 To loopNum
            Sleep (100)
            DoEvents
        Next
    Else
        MsgBox ("unknown value")
    End If

End Function

Function SysControl(strTxd As String)
    Dim i As Long

    If strTxd = "wait1000ms" Then
        For i = 1 To 10
            Sleep (100)
            DoEvents
        Next

    ElseIf strTxd = "msgbox" Then
        MsgBox ("wait...")

    End If

End Function