Go to Qiita Advent Calendar 2024 Top
LoginSignup
3
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

@pbjpkas

Excelで機器制御のGUIを作る

Posted at

1. はじめに

テストベンチを組んで動作確認をしたり自動テストをセットアップするのにターミナルで一つ一つコマンドを打ってもよいのですが機器制御のGUIがあると便利ですよね。

2. やりたいこと、やりたくないこと

  • フォームコントロールのボタン押下で機器をコマンドで制御する
    • 例1：「ver」ボタンを押すとUARTで接続している治具に"ver"コマンドが送信され、戻り値を取得する
    • 例2：「*IDN?」ボタンを押すと"*IDN?"コマンドがオシロスコープに送信され、戻り値を取得する
  • フォームコントロールのボタンからメソッドに引数を渡して実行する

概要

3. はまったこと

結論、フォームコントロールのボタンからメソッドに引数を渡して実行するにはマクロを「標準モジュール」に記述します。

  • 標準モジュールがない場合はプロジェクトを右クリック→挿入→標準モジュール
    標準モジュールの追加
  • 「Microsoft Excel Objects」のThisWorkBookにマクロを記述して実行すると「SubまたはFunctionが定義されていません。」というコンパイルエラーが発生します。
    VBAコンパイルエラー
  • このエラーのヘルプ（Sub、関数、またはプロパティが定義されていません (エラー 35)）には以下2つの原因が挙げられていますがどちらでもないです。
    • プロシージャの名前のスペルが誤っています。
    • [参照設定] ダイアログ ボックスで プロジェクトへの参照を明示的に追加せずに、そのプロジェクトからプロシージャを呼び出そうとしました。

4. 作ったもの（プログラム）

「オシロスコープをExcelで制御して波形データを取得する」のプログラムに以下のメソッドを追加します1。ソース全文は付録.Dをご参照ください。

  • フォームコントロールで引数を与えて呼出すマクロ(SCPI版)
  • フォームコントロールで引数を与えて呼出すマクロ(UART版)
  • セルに貼り付けている画像を削除するマクロ
  • オシロスコープのスクリーンショットの貼り付け先のセルの高さを取得するマクロ

4.1 フォームコントロールで引数を与えて呼出すマクロ(SCPI版)

'フォームコントロールで引数を与えて呼出すマクロ(SCPI)
'ColRxd、RowRxd：機器から受信したデータを出力するセルの座標
'StrTxd：機器へ送信する文字列
Sub btnSCPI(ColRxd As Long, RowRxd As Long, StrTxd As String)
    Cells(RowRxd, ColRxd) = ""
    Call ControlDSO(RowRxd, StrTxd, ColRxd)
End Sub

4.2 フォームコントロールで引数を与えて呼出すマクロ(UART版)

'フォームコントロールで引数を与えて呼出すマクロ(UART)
'ColRxd、RowRxd：機器から受信したデータを出力するセルの座標
'StrTxd：機器へ送信する文字列
Sub btnUART(ColRxd As Long, RowRxd As Long, StrTxd As String)
    Cells(RowRxd, ColRxd) = ""
    Call ControlTB(RowRxd, StrTxd, ColRxd)
End Sub

4.3 セルに貼り付けている画像を削除するマクロ

オシロスコープのスクリーンショットを貼る前に、すでにスクリーンショットが貼られていたらそれを削除するようにします。そのためのマクロです2。

'Col、Row：セルのアドレス
Function RemoveDisplayData(Col As Long, Row As Long)
    Dim pic As Picture
    For Each pic In ActiveSheet.Pictures
        If Not Intersect(pic.TopLeftCell, Cells(Row, Col)) Is Nothing Then
            pic.Delete
        End If
    Next
End Function

4.4 オシロスコープのスクリーンショットの貼り付け先のセルの高さを取得するマクロ

セルを結合しても.heightで得られるセルの高さはセル1個の高さです。そこで結合しているセルの各セルの高さを足して高さを求めます3。

'Col、Row：セルのアドレス
Function FindCellHeight(Col As Long, Row As Long)
    Dim lines As Long '結合されているセルの行数を格納する
    Dim height As Double 'セルの高さの合計を格納する
    Dim i As Long 'forループのカウンタ
    
    height = 0
    lines = Cells(Row, Col).MergeArea.Rows.Count
    For i = 0 To (lines - 1)
        height = height + Cells(Row + i, Col).height
    Next i
    FindCellHeight = height
End Function

5. 作ったもの（GUI）

プローブ補償信号の1kHzの矩形波信号の測定+αができる程度にボタンを配置してみます。
GUI sample

GUIパーツを配置しやすいようセルを結合したり方眼紙にしたりします。Excelのセル結合や方眼紙は何かとやり玉にあがるのですがこれは表示用のシートです、使える機能は何でも使ってササっと作ってしまいましょう。
GUI sample

6. マクロの登録

ファイル名!'メソッド名<空白>"引数1","引数2",…,"引数n"'
カーソルキーが効かないのでとってもやりづらいですが、、、
マクロの登録

7. おわりに

  • ボタンに対応するメソッドをボタンの数だけ量産することなしにExcelのGUIで機器制御できるようになりました。
  • オシロスコープのタイムベースをボタン一発で変更できるのは思っていたよりも便利と思いました。

付録.A Excel方眼紙ユーザにオススメのクイックツールバー設定

Excel方眼紙ユーザはクイックツールバーに以下2点を入れるのがお勧めです。

  • 枠線に合わせる[グリッドに合わせる]
  • オブジェクトの選択

クイックツールバーの設定

付録.B RIGOL DS1104Zの補足

DS1104Zの画面左上のカーソル情報は本体のつまみでタイムベースの設定を変更するとカーソル情報も連動して変更されるのですが、SCPIコマンドで変更した場合は連動しませんでした。カーソルを表示している場合はタイムベースを変更したら":CURS:MODE MAN"を送って強制的にカーソル情報を更新してください。
DS1104Z

付録.C Excelを利用したテスト自動化の記事

付録.D ソースコード全文

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

'フォームコントロールで引数を与えて呼出すマクロ(SCPI)
'ColRxd、RowRxd：機器から受信したデータを出力するセルの座標
'StrTxd：機器へ送信する文字列
Sub btnSCPI(ColRxd As Long, RowRxd As Long, StrTxd As String)
    Cells(RowRxd, ColRxd) = ""
    Call ControlDSO(RowRxd, StrTxd, ColRxd)
End Sub

'フォームコントロールで引数を与えて呼出すマクロ(UART)
'ColRxd、RowRxd：機器から受信したデータを出力するセルの座標
'StrTxd：機器へ送信する文字列
Sub btnUART(ColRxd As Long, RowRxd As Long, StrTxd As String)
    Cells(RowRxd, ColRxd) = ""
    Call ControlTB(RowRxd, StrTxd, ColRxd)
End Sub

'「テスト開始」ボタン押下で呼出すマクロ
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 = "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
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)
    
    If InStr(StrTxd, ":DISPlay:DATA?") > 0 Then
        Call RemoveDisplayData(ColRxd, Line)
        Call ReadDisplayData(ColRxd, Line, StrTxd, DSO)
    
    ElseIf InStr(StrTxd, ":WAVeform:DATA?") > 0 Then
        Call ReadWaveformData(ColRxd, Line, StrTxd, DSO)
        
    ElseIf InStr(StrTxd, "?") > 0 Then
        DSO.WriteString StrTxd
        ActiveSheet.Cells(Line, ColRxd) = Replace(DSO.ReadString(), vbLf, "")
    
    Else
        'MsgBox (StrTxd)
        DSO.WriteString StrTxd

    End If
    
    DSO.IO.Close
    Set DSO = Nothing
    Set RM = Nothing
End Function

'Col、Row：セルのアドレス
Function RemoveDisplayData(Col As Long, Row As Long)
    Dim pic As Picture
    For Each pic In ActiveSheet.Pictures
        If Not Intersect(pic.TopLeftCell, Cells(Row, Col)) Is Nothing Then
            pic.Delete
        End If
    Next
End Function

'Col、Row：セルのアドレス
Function FindCellHeight(Col As Long, Row As Long)
    Dim lines As Long '結合されているセルの行数を格納する
    Dim height As Double 'セルの高さの合計を格納する
    Dim i As Long 'forループのカウンタ
    
    height = 0
    lines = Cells(Row, Col).MergeArea.Rows.Count
    For i = 0 To (lines - 1)
        height = height + Cells(Row + i, Col).height
    Next i
    FindCellHeight = height
End Function

'拡張子は呼び出し元で付けること
Function GenerateDataFileName(Col As Long, Row As Long) As String
    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 DataFileName As String
    DataFileName = FilePath + "\" + FileName + "-" + SheetName + "-" + CStr(Col) + "-" + CStr(Row)
    
    GenerateDataFileName = DataFileName
End Function
    
Function ReadDisplayData(Col As Long, Row As Long, StrTxd As String, DSO As VisaComLib.FormattedIO488)
    DSO.WriteString StrTxd
    
    Dim ReadIEEEBlockData() As Byte
    ReadIEEEBlockData = DSO.ReadIEEEBlock(BinaryType_UI1)
    
    Dim DataFileName As String
    DataFileName = GenerateDataFileName(Col, Row) + ".png"

    Dim FreeFileNum As Long
    FreeFileNum = FreeFile
    
    Open DataFileName For Binary As #FreeFileNum
            Put #FreeFileNum, , ReadIEEEBlockData
    Close #FreeFileNum
    
    With ActiveSheet.Pictures.Insert(DataFileName)
        .Top = Cells(Row, Col).Top
        .Left = Cells(Row, Col).Left
        .height = FindCellHeight(Col, Row)
    End With
End Function

Function ReadWaveformData(Col As Long, Row As Long, StrTxd As String, DSO As VisaComLib.FormattedIO488)
    DSO.WriteString (":WAVeform:MODE NORMal")
    DSO.WriteString (":WAVeform:FORMat ASCii")
    DSO.WriteString (":WAVeform:STARt 1")
    DSO.WriteString (":WAVeform:STOP 1200")
    
    Dim Channel As String
    DSO.WriteString (":WAVeform:SOURce?")
    Channel = DSO.ReadString()
    Channel = Left(Channel, Len(Channel) - 1) '末尾の改行コードを捨てる
    
    Dim TimebaseScale As String
    DSO.WriteString (":TIMebase:SCALe?")
    TimebaseScale = DSO.ReadString()
    
    'WaveformDataはTMCデータ記述子ヘッダ(TMC data description header)と波形データの2つのパートで構成される。
    'TMCデータ記述子ヘッダ:
    '  #Nxxxxxxxxxの形式
    '  #:識別子
    '  N:Length Blockのバイト数(9)
    '  xxxxxxxxx:Length Block(波形データのバイト数を格納するブロック)
    '波形データ
    '  波形の各ポイントの電圧を、","で区切って羅列
    Dim WaveformData As String
    DSO.WriteString (":WAVeform:DATA?")
    WaveformData = DSO.ReadString()
        
    'TMCデータ記述子ヘッダ部分
    Dim TMCDataDescriptionHeader As String
    TMCDataDescriptionHeader = Left(WaveformData, 11)
    ActiveSheet.Cells(Row, Col) = TMCDataDescriptionHeader
    
    '波形データ部分
    WaveformData = Replace(Mid(WaveformData, 12), ",", vbCr)
    
    'save Waveform Data to file
    Dim DataFileName As String
    DataFileName = GenerateDataFileName(Col, Row) + ".csv"
    
    Dim DataString As String
    DataString = Channel + "/" + TimebaseScale + WaveformData
        
    Dim FreeFileNum As Long
    FreeFileNum = FreeFile
    
    Open DataFileName For Binary As #FreeFileNum
            Put #FreeFileNum, , DataString
    Close #FreeFileNum
End Function

'Line:送信データが記述されているセルの行番号
'StrTxd:送信データ
'ColRxd:受信データの格納先セルの列番号
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 = 115200
    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

  1. もし利用される場合は付録.Cのソースコード全文をそのまま持って行く方が無難です。この記事の作成に合わせて「オシロスコープをExcelで制御して波形データを取得する」から持ってきたプログラムに改修を加えています。 ↩

  2. 「マクロVBA指定した範囲内の画像を削除するマクロの組み方を教えて... - Yahoo!知恵袋」を引用、改修。 ↩

  3. 参考：Office TANAKA - Excel VBA Tips[結合セルを調べる] ↩

3
3
1

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
Sign upLogin
3
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?