Attribute VB_Name = "Module3"
Option Explicit '防止變量未定義

Public DMM1 As VisaComLib.FormattedIO488 ' 定義DMM KEITHLEY-2400
Public DMM2 As VisaComLib.FormattedIO488 ' 定義DMM HP-34401A
Public DMM3 As VisaComLib.FormattedIO488 ' 定義DMM HP-34907
Public DMM4 As VisaComLib.FormattedIO488 ' 定義DMM HP-6611C

'定義KEITHLEY-2400地址為24
'定義HP-34401A地址為22
'定義HP-34970地址為
'定義HP-6611C地址為5

'對KEITHLEY-2400操作
'打開設備
'=============================
Public Function keithley2400open()
    On Error GoTo ioerror
    Dim mgr1 As VisaComLib.ResourceManager
    Set mgr1 = New VisaComLib.ResourceManager
    Set DMM1 = New VisaComLib.FormattedIO488
    Set DMM1.IO = mgr1.Open("GPIB::24")
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'系統函數
'復位
'==============================================
Public Function keithley2400rst()
    On Error GoTo ioerror
    DMM1.WriteString "*RST"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查詢
'==============================================
Public Function keithley2400idn() As String
    On Error GoTo ioerror
    DMM1.WriteString "*IDN?"
    keithley2400idn = DMM1.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'版本
'==============================================
Public Function keithley2400vers() As String
    On Error GoTo ioerror
    DMM1.WriteString ":Syst:Vers?"
    keithley2400vers = DMM1.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'輸出開
'==============================================
Public Function keithley2400outputon()
    On Error GoTo ioerror
    DMM1.WriteString ":OUTPUT ON"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'輸出關
'==============================================
Public Function keithley2400outputoff()
    On Error GoTo ioerror
    DMM1.WriteString ":OUTPUT OFF"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'設置電壓
'==============================================
Public Function keithley2400setvolatge(value As Single)
    On Error GoTo ioerror
    DMM1.WriteString ":SOUR:FUNC VOLT "
    DMM1.WriteString ":SOUR:VOLT " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'設置電流
'==============================================
Public Function keithley2400setcurrent(value As Single)
    On Error GoTo ioerror
    'DMM1.WriteString ":SOUR:volt:RANG 2 "
    'DMM1.WriteString ":SOUR:volt:LEV 2 "
    DMM1.WriteString ":SOUR:FUNC CURR "
    DMM1.WriteString ":SOUR:CURR " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測試電壓
'==============================================
Public Function keithley2400sensvolatge() As Single
    
    On Error GoTo ioerror
    'DMM1.WriteString ":SOUR:FUNC VOLT "
    'DMM1.WriteString "*rst"
    'DMM1.WriteString ":SENS:FUNC :OFF:ALL"
    DMM1.WriteString ":SENS:FUNC:ON 'VOLT'"
    DMM1.WriteString ":OUTPUT ON"
    'DMM1.WriteString ":READ?"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測試電流
'==============================================
Public Function keithley2400senscurrent(value As Single)
    On Error GoTo ioerror
    'DMM1.WriteString ":SOUR:VOLT:RANG 2 "
    'DMM1.WriteString ":SOUR:VOLT:LEV 2 "
    DMM1.WriteString ":SOUR:FUNC CURR "
    DMM1.WriteString ":SOUR:CURR " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'對HP-34401A操作
'打開設備
'=============================
Public Function hp34401aopen()
    On Error GoTo ioerror
    Dim mgr2 As VisaComLib.ResourceManager
    Set mgr2 = New VisaComLib.ResourceManager
    Set DMM2 = New VisaComLib.FormattedIO488
    Set DMM2.IO = mgr2.Open("GPIB::22")
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'系統查詢函數
'查詢
'==============================================
Public Function hp34401aidn() As String
    On Error GoTo ioerror
    DMM2.WriteString "*IDN?"
    hp34401aidn = DMM2.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'版本
'==============================================
Public Function hp34401avers() As String
    On Error GoTo ioerror
    DMM2.WriteString ":Syst:Vers?"
    hp34401avers = DMM2.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'復位
'==============================================
Public Function hp34401arst()
    On Error GoTo ioerror
    DMM2.WriteString "*RST"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測量1次直流電壓
'==============================================
Public Function hp34401ameasuredcvoltage() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Voltage:DC?"
    hp34401ameasuredcvoltage = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測量1次交流電壓
'==============================================
Public Function hp34401ameasureacvoltage() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Voltage:AC?"
    hp34401ameasureacvoltage = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測量1次直流電流
'==============================================
Public Function hp34401ameasuredccurrent() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Current:DC?"
    hp34401ameasuredccurrent = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測量1次交流電流
'==============================================
Public Function hp34401ameasureaccurrent() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Current:AC?"
    hp34401ameasureaccurrent = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'對HP-6611C操作
'打開設備
'=============================
Public Function hp6611copen()
    On Error GoTo ioerror
    Dim mgr3 As VisaComLib.ResourceManager
    Set mgr3 = New VisaComLib.ResourceManager
    Set DMM3 = New VisaComLib.FormattedIO488
    Set DMM3.IO = mgr3.Open("GPIB::5")
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'系統查詢函數
'復位
'==============================================
Public Function hp6611crst()
    On Error GoTo ioerror
    DMM3.WriteString "*RST"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查詢設備
'==============================================
Public Function hp6611cidn() As String
    On Error GoTo ioerror
    DMM3.WriteString "*IDN?"
    hp6611cidn = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查詢版本
'==============================================
Public Function hp6611cvers() As String
    On Error GoTo ioerror
    DMM3.WriteString ":Syst:Vers?"
    hp6611cvers = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查詢系統錯誤
'==============================================
Public Function hp6611csyserror() As String
    On Error GoTo ioerror
    DMM3.WriteString ":SYSTem:ERRor?"
    hp6611csyserror = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查詢系統語言
'==============================================
Public Function hp6611csyslanguage() As String
    On Error GoTo ioerror
    DMM3.WriteString ":SYSTem:LANGuage?"
    hp6611csyslanguage = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測量函數
'測量電流
'==============================================
Public Function hp6611cmeasurecurrent() As Single
    On Error GoTo ioerror
    DMM3.WriteString ":MEASure:CURRent?"
    hp6611cmeasurecurrent = DMM3.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'測量電壓
'==============================================
Public Function hp6611cmeasurevoltage() As Single
    On Error GoTo ioerror
    DMM3.WriteString ":MEASure:VOLTage?"
    hp6611cmeasurevoltage = DMM3.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'設置電壓
'==============================================
Public Function hp6611csetvoltage(value As Single)
    On Error GoTo ioerror
    DMM3.WriteString " VOLT " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'設置電流
'==============================================
Public Function hp6611csetcurrent(value As Single)
    On Error GoTo ioerror
    DMM3.WriteString " CURR " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'設置輸出開
'==============================================
Public Function hp6611coutputon()
    On Error GoTo ioerror
    DMM3.WriteString ":OUTPut ON"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'設置輸出關
'==============================================
Public Function hp6611coutputoff()
    On Error GoTo ioerror
    DMM3.WriteString ":OUTPut OFF"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function