Dim nRun As Boolean Dim nOffset As Integer Dim aBuff(32) As Byte Dim strBuf As String Dim nAcquired As Double Dim bAcquired As Boolean ' excel app Dim RangeX1, RangeY1, RangeX2, RangeY2 As Integer Dim IterateX, IterateY As Integer Dim bAutocall As Boolean Private Sub CommandButton1_Click() SPort.Open (Port.Value) SPort.InitString ("2400,N,7,1") SPort.DTR = True SPort.RTS = False nRun = True bAutocall = False nOffset = 0 End Sub Private Sub CommandButton3_Click() Dim sel As Variant Dim width, height As Integer If Selection.Count > 1 Then sel = Selection.Cells width = UBound(sel, 2) height = UBound(sel, 1) RangeX1 = Selection.Column RangeY1 = Selection.Row RangeX2 = RangeX1 + width RangeY2 = RangeY1 + height IterateX = RangeX1 IterateY = RangeY1 bAutocall = True Handler Else If Acquired Then ActiveCell.Value = Acquire() ActiveCell.Offset(1, 0).Select End If End If End Sub Private Sub Handler() If Not Acquired() Then Exit Sub 'ActiveCell.Offset(IterateY - RangeY1, IterateX - RangeX1).Select ActiveCell.Value = Acquire() ActiveCell.Offset(1, 0).Select 'ActiveCell.Offset(-IterateY + RangeY1, -IterateX + RangeX1).Select IterateY = IterateY + 1 If IterateY >= RangeY2 Then ActiveCell.Offset(-(RangeY2 - RangeY1), 1).Select IterateY = RangeY1 IterateX = IterateX + 1 If IterateX >= RangeX2 Then ActiveCell.Offset(0, -(RangeX2 - RangeX1)).Select IterateX = RangeX1 End If End If End Sub Private Sub SPort_OnRxChar(ByVal Count As Long) Dim Buff() As Byte ReDim Buff(1 To Count) Dim i As Integer Dim Received As Long Dim ch As Byte Received = SPort.Read(Buff(1), Count) For i = 1 To Count ch = Buff(i) And 127 If ch > 30 Then strBuf = strBuf & Chr(ch) Else strBuf = strBuf & "?" If ch = 13 Or ch = 10 Then If (nOffset > 0) Then ParseData nOffset = -1 Else If (nOffset >= 0) Then aBuff(nOffset) = ch End If If nOffset < 32 Then nOffset = nOffset + 1 Next i strBuf = Right(strBuf, 32) TextBox2.Text = strBuf End Sub Private Sub CommandButton2_Click() nRun = False SPort.Close End Sub Private Sub ParseData() Dim str As String For i = 0 To nOffset - 1 str = str & Chr(aBuff(i)) Next TextBox1.Text = str & " (" & nOffset & ")" If nOffset <> 9 Then Exit Sub ' Dim sJedn As String Dim sProp As String Dim sUnits As String Dim bAuto As Boolean Dim bNegative As Boolean Dim nNumber As Integer Dim nDiv As Integer Dim sForm As String Dim bOverflow As Boolean Dim sRange As String Dim nStatus As Integer Dim bBeep As Boolean Dim fMul As Double bBeep = False bAuto = False nDiv = 1 fMul = 1 nStatus = aBuff(6) - &H30 bNegative = nStatus And 4 bOverflow = nStatus And 1 Select Case Chr(aBuff(5)) Case ";": sJedn = "U" Select Case Chr(aBuff(8)) Case ":": bAuto = True sProp = "DC" Case "8": bAuto = False sProp = "DC" Case "6": bAuto = True sProp = "AC" Case "4": bAuto = False sProp = "AC" End Select Select Case Chr(aBuff(0)) Case "0": nDiv = 10 sUnits = "mV" sForm = "###.#" sRange = "400" fMul = 0.001 Case "1": nDiv = 1000 sUnits = "V" sForm = "#.###" sRange = "4" fMul = 1 Case "2": nDiv = 100 sUnits = "V" sForm = "##.##" sRange = "40" fMul = 1 Case "3": nDiv = 10 sUnits = "V" sForm = "###.#" sRange = "400" fMul = 1 Case "4": nDiv = 1 sUnits = "V" sForm = "####" If sProp = "DC" Then sRange = "1000" Else sRange = "750" End If fMul = 1 End Select Case "3": sJedn = "R" sProp = "" Select Case Chr(aBuff(0)) Case "0": nDiv = 10 sUnits = "O" sForm = "###.#" sRange = "400" fMul = 1 Case "1": nDiv = 1000 sUnits = "kO" sForm = "#.###" sRange = "4" fMul = 1000 Case "2": nDiv = 100 sUnits = "kO" sForm = "##.##" sRange = "40" fMul = 1000 Case "3": nDiv = 10 sUnits = "kO" sForm = "###.#" sRange = "400" fMul = 1000 Case "4": nDiv = 1000 sUnits = "MO" sForm = "#.###" sRange = 4 fMul = 1000000 Case "5": nDiv = 100 sUnits = "MO" sForm = "##.##" sRange = 40 fMul = 1000000 End Select nStatus = aBuff(8) - &H30 bAuto = nStatus And 2 Case "5": sJedn = "R" sProp = "beep" bAuto = False Select Case Chr(aBuff(0)) Case "0": nDiv = 10 sUnits = "O" sForm = "###.#" 'µ__°µ°" sRange = "400" fMul = 1 End Select nStatus = aBuff(6) - &H30 bBeep = (nStatus And 1) bBeep = Not bBeep 'bBeep = False End Select nNumber = 0 nNumber = nNumber + (aBuff(1) - &H30) * 1000 nNumber = nNumber + (aBuff(2) - &H30) * 100 nNumber = nNumber + (aBuff(3) - &H30) * 10 nNumber = nNumber + (aBuff(4) - &H30) * 1 If sJedn = "" Then Display.Text = nNumber DispProp.Text = "?" DispOpt.Text = "" DispRange.Text = "" Exit Sub End If If bNegative Then nNumber = -nNumber If bBeep And nNumber / nDiv > 40 Then bBeep = False End If If bOverflow Then If sJedn = "R" Then Display.Text = "Inf" bAcquired = False Else Display.Text = "!!!" bAcquired = False End If Else Display.Text = (nNumber / nDiv) & " " & sUnits bAcquired = True nAcquired = (nNumber / nDiv) * fMul End If DispProp.Text = sProp If bAuto Then DispOpt.Text = "Auto" ElseIf bBeep Then DispOpt.Text = "Beep" Else DispOpt.Text = "" End If If sProp <> "" Then DispRange.Text = "max : " & sRange & " " & sUnits & " (" & sProp & ")" Else DispRange.Text = "max : " & sRange & " " & sUnits End If If bAcquired And bAutocall Then Handler End Sub Function Acquired() As Boolean Acquired = bAcquired End Function Function Acquire() As Double Acquire = nAcquired bAcquired = False End Function