Excel VBA 读取保存Keysight示波器数据 平均模式

示波器型号：Keysight MSO-X 4154A

Excel版本：Microsoft Office Professional Plus 2010

引用：

VISA-COM 5.9 Type Library

Keysight VISA COM Resource Manager

平均模式时防止操作未完成发生错误：

->使能ESE中OPC，bit 0，&H01

->使用Digitized采集：写入":DIGitize"，写入"*OPC"

->有采集请求时ESR使STB bit6位置1

-> 检查STB中bit6位（&H20），置1开始读取数据

    Public myScope As New VisaComLib.FormattedIO488
    Public ioMgr As New VisaComLib.ResourceManager
    
    Public intFormat As Integer
    Public intType As Integer
    Public lngPoints As Long
    Public lngCount As Long
    Public Xincrement As Double
    Public Xorigin As Double
    Public Xreference As Long
    Public Yincrement As Single
    Public Yorigin As Single
    Public Yreference As Long
    Public rawdata As Variant
    Public lngI As Long


Sub CommandButton1_Click()

    
    Set myScope = New VisaComLib.FormattedIO488
    Set myScope.IO = ioMgr.Open("TCPIP0::192.168.100.100::inst0::INSTR")
    myScope.IO.Clear
    
    'myScope.WriteString ":AUToscale"
    'myScope.WriteString ":RUN"
    myScope.WriteString ":ACQuire:TYPE AVERage"
    myScope.WriteString ":ACQuire:COUNt 1000"
    
    '检查平均模式
    Dim typeRes As String
    myScope.WriteString ":ACQuire:TYPE?"
    typeRes = myScope.ReadString
    If Not (StrComp(typeRes, "AVER ")) Then
        MsgBox ("平均采集设置失败")
        myScope.WriteString ":ACQuire:TYPE AVERage"
        myScope.WriteString ":ACQuire:COUNt 1000"
    End If
         


    Dim Preamble()


	Dim varInitialESE As Variant
	myScope.WriteString "*ESE?"
	varInitialESE = myScope.ReadNumber							'保存ESE原始值				
	myScope.WriteString "*ESE " + CStr(CInt("&H01"))			'只使能ESE中OPC位
' Acquire using :DIGitize. Set up OPC bit to be set when the operation is complete.
	myScope.WriteString ":DIGitize"
	myScope.WriteString "*OPC"												
' Assume the oscilloscope will trigger, if not put a check here.
' Wait until OPC becomes true (bit 6 of Status Byte register, STB,
' from Standard Event Status register, ESR, is set). STB can be
' read during :DIGitize without generating a timeout.
	Do
	Sleep 4000 ' Poll more often than the timeout setting.
	varQueryResult = myScope.IO.ReadSTB
	Loop While (varQueryResult And &H20) = 0				'直到STB中bit6置1，说明有采集需求
' Clear ESR and restore previously saved *ESE mask.
	myScope.WriteString "*ESR?" ' Clear ESR by reading it 清除ESR
	varQueryResult = myScope.ReadNumber
	myScope.WriteString "*ESE " + CStr(varInitialESE)		'写入ESE原始值
    
    myScope.WriteString ":WAVEFORM:FORMAT BYTE"
    myScope.WriteString ":WAVEFORM:BYTE MSBF"
    myScope.WriteString ":WAVEFORM:POINTS 1000"
      
    myScope.WriteString ":WAVEFORM:PREamble"   ' Query for the preamble.
    Debug.Print "PREamble get."
    Preamble = myScope.ReadList   ' Read preamble information and assign to array.
    Debug.Print "ReadList get."
    
    'Assign preamble values from the array to individual variables.
      intFormat = Preamble(0)
      intType = Preamble(1)
      lngPoints = Preamble(2)
      lngCount = Preamble(3)
      dblXIncrement = Preamble(4)
      dblXOrigin = Preamble(5)
      lngXReference = Preamble(6)
      sngYIncrement = Preamble(7)
      sngYOrigin = Preamble(8)
      lngYReference = Preamble(9)

    'Read the waveform data from channel 1
      myScope.WriteString ":WAVEFORM:SOURCE CHANNEL1"
      myScope.WriteString ":WAVEFORM:DATA?"
      rawdata = myScope.ReadIEEEBlock(BinaryType_UI1)

    
    '时间文件名
    t = Format(Now, "yyyy-mm-dd hhmmss")
    Debug.Print t
    ActiveWorkbook.SaveAs "F:\示波器数据\示波器数据 " + t + ".xlsx", True

    For lngI = 0 To UBound(rawdata)
        stroutput = CStr((rawdata(lngI) - lngYReference) * sngYIncrement + sngYOrigin)
        ActiveSheet.Cells(lngI + 1, 2) = stroutput
        stroutput = CStr(((lngI - lngXReference) * dblXIncrement + dblXOrigin) * 1000000)
        ActiveSheet.Cells(lngI + 1, 1) = stroutput
    Next lngI
    
    ActiveWorkbook.Close    '采集结束，关闭文件
    


End Sub