' ※※※※※※※※※※※※※※※※※
' 「NI-VISA 14.0」をインストール
' [Excelを起動]-[開発]-[Visual Basic Editor]-[挿入]-[標準モジュール]
' -[ツール]-[参照設定]-[キーボードの「V」を押下]-[VISA COM X.X Type Library選択]-[OK]
' -[標準モジュールに、このテキストを全選択コピーして、貼り付け]
' -[サブプロシージャを選択]-[実行（F5）]
' ※※※※※※※※※※※※※※※※※
' KERNEL32.dll 内の Sleep を呼び出すための宣言
Public Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long) ' 64bitのPC対応のため、PtrSafe付与
' このモジュールで使用する変数の宣言（各サブプロシージャ実行後に変数を削除するSubをCallし、初期化）
Dim RM As New VisaComLib.ResourceManager ' ResourceManager オブジェクトの宣言と作成
Dim INST01 As New VisaComLib.FormattedIO488 ' FormattedIO488 オブジェクトの宣言と作成
Dim INST02 As New VisaComLib.FormattedIO488 ' FormattedIO488 オブジェクトの宣言と作成
Dim start_time As Double ' タイマー開始時間の変数の宣言
Dim fin_time As Double ' タイマー終了時間の変数の宣言
Dim ret1() As String ' 測定器からの応答を保存する変数（配列）の宣言
Dim ret2() As String ' 測定器からの応答を保存する変数（配列）の宣言
Dim aData() As String ' 測定器からの応答をまとめる変数（配列）の宣言
Dim i As Long ' 連番の変数の宣言（サブプロシージャが切り替わっても使えるようにここで宣言）
Const ステップ As String = "50" ' 逐次移動のステップ数（ミクロン単位）の定数の宣言
Const Interval As Double = 180000 ' インターバル時間[ms単位]の定数の宣言
Sub TimerStart()
start_time = Timer ' タイマー開始
End Sub
Sub TimerStop()
fin_time = Timer ' タイマー終了
End Sub
Sub Connection() '各機器の接続、タイムアウトを指定するサブプロシージャ
' ※※※※※※※※※※※※※※※※※
' 「NI MAX」を起動し，デバイスとインタフェースから「VISAリソース名」を確認してください
' LAN接続の場合は，[スタート + R]-[cmdと入力]-[ping 10.34.1.105と入力]のように導通点検も実施してください。
' ※※※※※※※※※※※※※※※※※
Set INST01.IO = RM.Open("TCPIP::10.34.1.105::INSTR") ' IO Resource オブジェクトの作成【クロスケーブルで接続された機器】
Set INST02.IO = RM.Open("ASRL5::INSTR") ' IO Resource オブジェクトの作成【USBで接続されたCOMポート5の機器】
INST01.IO.Timeout = 15000 ' 機器１のタイムアウトを15秒に設定[ms単位]（※測定時間を考慮）
INST02.IO.Timeout = 30000 ' 機器２のタイムアウトを30秒に設定[ms単位]（※命令実行してから停止するまでの時間を考慮）
End Sub
Sub DisConnectionAndVariableErase() '接続解除、変数初期化するサブプロシージャ
Erase ret1 ' 配列ret1の初期化
Erase ret2 ' 配列ret2の初期化
Erase aData ' 配列aDataの初期化
INST01.IO.Close ' IO Resource オブジェクトの解放
INST02.IO.Close ' IO Resource オブジェクトの解放
Set INST01 = Nothing ' FormattedIO488 オブジェクトの解放
Set INST02 = Nothing ' FormattedIO488 オブジェクトの解放
Set RM = Nothing ' ResourceManager オブジェクトの解放
Application.Speech.Speak "おまたせしました", SpeakAsync:=True
MsgBox "お待たせしました" _
& vbCrLf & "" _
& vbCrLf & "" _
& vbCrLf & "" _
& vbCrLf & " ∧ ∧＿__" _
& vbCrLf & " ／(*ﾟーﾟ) ／＼" _
& vbCrLf & " ／|￣∪∪￣￣ |＼／" _
& vbCrLf & " | OMATASE |／" _
& vbCrLf & " ￣￣￣￣￣" _
, vbOKOnly + vbInformation, "「お待たせしました」"
End Sub
Sub SaveCSVALL() ' 測定し、データをUSBに保存
' 「Single掃引が終了してから→E(機器1に差したUSB)にCSV ALL保存→実行完了の問い合わせ」
INST01.WriteString "SSI; *WAI; SVCSVA '" & "WaveData" & Format(Date, "yyyymmdd") & "_" & Format(i, "000") & "',E; *OPC?"
Do
j = INST01.ReadString() ' 信号読み取り（実行完了して「1」を受け取るまで繰り返し）
Loop Until j = 1
End Sub
Sub StagePosition() '機器2の位置情報を取得
INST02.WriteString "!:" & vbCrLf
Do
j = INST02.ReadString() ' 信号読み取り（実行完了して「"R" & vbCrLf」を受け取るまで繰り返し(途中は「"B" & vbCrLf」)）
Loop Until j = "R" & vbCrLf
INST02.WriteString "Q:" & vbCrLf
ret2() = INST02.ReadList(ASCIIType_BSTR) ' 問い合わせた情報を配列に格納
ret2(0) = Replace(ret2(0), " ", "") ' ret2(0)の空白を消去
End Sub
Sub RepeatSweepUSB() '一定時間おきに測定し、USBにデータ保存を実行するサブプロシージャ
Set INST01.IO = RM.Open("TCPIP::10.34.1.105::INSTR") ' IO Resource オブジェクトの作成
INST01.IO.Timeout = 15000 ' タイムアウトを設定[ms単位]（※測定時間を考慮）
For i = 0 To 5 ' ★ループ回数を入力
Call TimerStart ' タイマー開始[0.00秒単位]
Call SaveCSVALL ' 測定し、データをUSBに保存
Call TimerStop ' タイマー終了[0.00秒単位]
k = Interval - (fin_time - start_time) * 1000 ' （インターバル時間） － （測定及びデータ保存にかかった時間）
If k > 0 Then
Sleep k ' ミリ秒単位で処理停止（1000で1秒）
End If
Next i
INST01.IO.Close ' IO Resource オブジェクトの解放
Set INST01 = Nothing ' FormattedIO488 オブジェクトの解放
Set RM = Nothing ' ResourceManager オブジェクトの解放
End Sub
Sub PointByPointUSB() '条件を変えて測定し、USBにデータ保存を実行するサブプロシージャ
Call Connection ' 接続
INST01.WriteString "PKS PEAK" ' 「ピークサーチ」
INST02.WriteString "D:1S100F100R0" & vbCrLf
Do
j = INST02.ReadString() ' 信号読み取り（実行完了して「"OK" & vbCrLf」を受け取るまで繰り返し(途中は「"NG" & vbCrLf」)）
Loop Until j = "OK" & vbCrLf
Call TimerStart ' タイマー開始
i = 0 ' 連番ゼロ
Cells(1, 1) = i ' 連番をシートの１列目に貼り付け
Call StagePosition ' 機器2の位置情報
Cells(i + 1, 2) = ret2(0) ' ステージの位置情報を２列目に貼り付け（ret2(0)にステージ座標）
DoEvents ' 画面更新の強制
Call SaveCSVALL ' 測定し、データをUSBに保存
INST01.WriteString "TMK?" ' 「ピーク情報問い合わせ」
ret1() = INST01.ReadList(ASCIIType_BSTR) ' 問い合わせたピーク情報を配列に格納
ReDim Preserve aData(1, i)
aData(0, i) = ret1(0)
aData(1, i) = ret1(1)
For i = 1 To 5 ' ★ループ回数を入力
INST02.WriteString "M:1+P" & ステップ & vbCrLf & "G:" & vbCrLf ' 相対パルス座標で＋方向へ移動
Do
j = INST02.ReadString() ' 信号読み取り（実行完了して「"OK" & vbCrLf」を受け取るまで繰り返し(途中は「"NG" & vbCrLf」)）
Loop Until j = "OK" & vbCrLf
Sleep 500 ' ミリ秒単位で処理停止（1000で1秒）（条件を変える度に時間を置く場合に指定）
Call SaveCSVALL ' 測定し、データをUSBに保存
Call StagePosition ' 機器2の位置情報
Cells(i + 1, 1) = i ' 連番をシートの１列目に貼り付け
Cells(i + 1, 2) = ret2(0) ' 機器2の位置情報をシートの２列目に貼り付け（ret2(0)）
INST01.WriteString "TMK?" ' 「ピーク情報問い合わせ」
ret1() = INST01.ReadList(ASCIIType_BSTR) ' 問い合わせたピーク情報を配列に格納
ReDim Preserve aData(1, i)
aData(0, i) = ret1(0)
aData(1, i) = ret1(1)
ActiveWindow.ScrollRow = i ' 画面をi番目の行にスクロール
DoEvents ' 画面更新の強制
Next i
Call TimerStop ' タイマー終了
For i = 0 To UBound(aData, 2)
aData(1, i) = Replace(aData(1, i), "DBM", "")
Next i
Range(Cells(1, 3), Cells(1 + UBound(aData, 2), 4)) = WorksheetFunction.Transpose(aData) ' ピーク情報をシートの３列目と４列目に貼り付け
Call DisConnectionAndVariableErase ' 変数初期化、接続解除
End Sub
Sub SingleSweepExcelSheet() '測定したデータをExcelシート上に書き込むサブプロシージャ
Set INST01.IO = RM.Open("TCPIP::10.34.1.105::INSTR") ' IO Resource オブジェクトの作成
INST01.IO.Timeout = 15000 ' タイムアウトを設定[ms単位]（※測定時間を考慮）
INST01.WriteString "SSI; *OPC?" ' 「測定→実行完了の問い合わせ」
Do
j = INST01.ReadString() ' 信号読み取り（実行完了して「1」を受け取るまで繰り返し）
Loop Until j = 1
INST01.WriteString "DCA?" ' 「測定データの読み取り」（横軸）（0:開始,1:終了,2:ポイント数）
ret1() = INST01.ReadList(ASCIIType_BSTR) ' 応答の受け取り（配列で）
Cells(1, 1) = ret1(0) ' 読み取ったデータを、シートのA列に書き込み
Cells(1, 1).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=(ret1(1) - ret1(0)) / (ret1(2) - 1), _
Stop:=ret1(1), Trend:=False
INST01.WriteString "DQA?" ' 「測定データの読み取り」（縦軸）
aData = INST01.ReadList(ASCIIType_BSTR) ' 応答の受け取り（配列で）
For i = 0 To UBound(aData)
Cells(i + 1, 2) = aData(i) ' 読み取ったデータを、シートのB列に書き込み
Next i
Beep ' 終了通知のビープ音
Erase ret1 ' 配列ret1の初期化
Erase aData ' 配列aDataの初期化
INST01.IO.Close ' IO Resource オブジェクトの解放
Set INST01 = Nothing ' FormattedIO488 オブジェクトの解放
Set RM = Nothing ' ResourceManager オブジェクトの解放
End Sub
ステッパモータの購入は、いろいろ安くなったらOKとのこと…諦めるしかないか…