Регистратор XML-данных ультразвуковых аппаратов Hielscher в Excel в реальном времени

' ==============================================================================
' Realtime Excel Logger for Hielscher Sonicator XML Data
'
' Description:
' This VBA module fetches XML data from a Hielscher sonicator over the network
' (typically from a local IP like http://192.168.233.233/mdata.xml), parses it,
' logs real-time data into Excel, and visualizes selected parameters (Power, Amplitude,
' and Energy) using a live updating scatter-line chart.
'
' Disclaimer & License:
' This script is provided "as is" without any warranty. It is free for non-commercial
' use, and redistribution is permitted only with attribution. Resale or inclusion in
' commercial software is strictly prohibited without explicit permission.
' (c) Hielscher Ultrasonics GmbH (Germany), 2025. All rights reserved. https://www.hielscher.com
' Last Update: June 17th, 2025, for sonicator software version 25.0.1
' ==============================================================================

' === Realtime Excel Logger Module ===
Dim nextRow As Long                     ' Row index for logging the next data point
Dim chartObject As chartObject          ' Reference to the live chart object
Dim isRunning As Boolean                ' Controls whether logging continues

' === MAIN ENTRY POINT ===
Sub InitLogger()
    Dim ws As Worksheet
    Set ws = Sheet1                     ' Use the first worksheet

    ws.Cells.Clear                      ' Clear all existing content on the sheet

    ' Request and store the XML source IP address
    ws.Cells(1, 1).Value = "XML Source"
    ws.Cells(1, 2).Value = InputBox("Enter device IP address", "XML Source", "http://192.168.233.233/mdata.xml")

    ' Create header row starting at row 2
    ws.Cells(2, 1).Resize(1, 14).Value = Array( _
        "Timestamp", "Status", "Total Power (W)", "Net Power (W)", "Amplitude (%)", _
        "Energy (Ws)", "ADC", "Frequency (Hz)", "Temperature (°C)", "Time (s)", _
        "ControlBits", "LimitType", "SetPower (%)", "Cycle (%)")

    nextRow = 3                         ' Start logging at row 3
    isRunning = True                    ' Enable logging loop
    Application.OnTime Now + TimeSerial(0, 0, 1), "LoggerTick" ' Schedule first data fetch
End Sub

' === PERIODIC TIMER CALLBACK ===
Sub LoggerTick()
    If Not isRunning Then Exit Sub
    FetchOnce
    Application.OnTime Now + TimeSerial(0, 0, 1), "LoggerTick" ' Schedule next fetch
End Sub

' === FETCH AND LOG DATA ===
Sub FetchOnce()
    Dim ipAddress As String, rawData As String
    Dim dataFields() As String, mStart As Long, mEnd As Long
    Dim ws As Worksheet: Set ws = Sheet1

    ipAddress = Trim(ws.Cells(1, 2).Value)   ' Get IP from input cell
    If ipAddress = "" Then Exit Sub          ' Exit if IP is missing

    rawData = GetMDataXML(ipAddress)         ' Fetch the raw XML from device
    If rawData = "" Then Exit Sub            ' Exit if fetch failed

    ' Extract only the content inside  ... 
    mStart = InStr(rawData, "")
    mEnd = InStr(rawData, "")
    If mStart = 0 Or mEnd = 0 Then Exit Sub  ' Exit if tag not found

    rawData = Mid(rawData, mStart + 7, mEnd - mStart - 7)
    dataFields = Split(rawData, ";")        ' Parse by semicolon delimiter
    If UBound(dataFields) < 12 Then Exit Sub ' Ensure all fields are present

    ' Determine next available row
    nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

    ' Write parsed values into worksheet
    With ws
        .Cells(nextRow, 1).Value = Format(Now, "yyyy-mm-dd HH:nn:ss")           ' Timestamp (rounded to seconds)
        .Cells(nextRow, 2).Value = Val(dataFields(0))                            ' Status
        .Cells(nextRow, 3).Value = Val(dataFields(1)) / 10                       ' Total Power (W)
        .Cells(nextRow, 4).Value = Val(dataFields(2)) / 10                       ' Net Power (W)
        .Cells(nextRow, 5).Value = Val(dataFields(3)) / 10                       ' Amplitude (%)
        .Cells(nextRow, 6).Value = Val(dataFields(4))                            ' Energy (Ws)
        .Cells(nextRow, 7).Value = Val(dataFields(5)) / 10                       ' ADC
        .Cells(nextRow, 8).Value = Val(dataFields(6))                            ' Frequency (Hz)
        .Cells(nextRow, 9).Value = IIf(Val(dataFields(7)) = 2550, "", Val(dataFields(7)) / 10) ' Temperature (°C), blank if 255
        .Cells(nextRow, 10).Value = Val(dataFields(8)) / 10                      ' Time (s)
        .Cells(nextRow, 11).Value = Val(dataFields(9))                           ' ControlBits
        .Cells(nextRow, 12).Value = IIf(Val(dataFields(10)) = 0, "", Val(dataFields(10)))     ' LimitType, blank if 0
        .Cells(nextRow, 13).Value = Val(dataFields(11)) / 20                     ' SetPower (%)
        .Cells(nextRow, 14).Value = Val(dataFields(12)) / 10                     ' Cycle (%).Value = Val(dataFields(12)) / 10     ' Cycle (%)
    End With

    UpdateChart
End Sub

' === CREATE / UPDATE SCATTER-LINE CHART ===
Sub UpdateChart()
    Dim ws As Worksheet: Set ws = Sheet1
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If lastRow < 4 Then Exit Sub

    ' Format timestamp column to display yyyy-mm-dd HH:mm:ss
    ws.Columns(1).NumberFormat = "yyyy-mm-dd hh:mm:ss"

    ' Create chart if not already initialized
    If chartObject Is Nothing Then
        Set chartObject = ws.ChartObjects.Add(Left:=ws.Cells(2, 16).Left, Top:=ws.Cells(2, 16).Top, Width:=500, Height:=300)
        chartObject.Name = "LiveChart"
    End If

    ' Configure the scatter line chart with latest data
    With chartObject.Chart
        .ChartType = xlXYScatterLines
        Do While .SeriesCollection.Count > 0: .SeriesCollection(1).Delete: Loop

        ' Plot Total Power
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "Power (W)"
        .SeriesCollection(1).XValues = ws.Range("A3:A" & lastRow)
        .SeriesCollection(1).Values = ws.Range("C3:C" & lastRow)

        ' Plot Amplitude
        .SeriesCollection.NewSeries
        .SeriesCollection(2).Name = "Amplitude (%)"
        .SeriesCollection(2).XValues = ws.Range("A3:A" & lastRow)
        .SeriesCollection(2).Values = ws.Range("E3:E" & lastRow)

        ' Plot Energy
        .SeriesCollection.NewSeries
        .SeriesCollection(3).Name = "Energy (Ws)"
        .SeriesCollection(3).XValues = ws.Range("A3:A" & lastRow)
        .SeriesCollection(3).Values = ws.Range("F3:F" & lastRow)

        .HasTitle = True
        .ChartTitle.Text = "Hielscher Sonicator: Live Chart"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "Time"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "Value"

        ' Format the X-axis to show MM:SS
        .Axes(xlCategory).TickLabels.NumberFormat = "mm:ss"
    End With
End Sub

' === FETCH XML VIA PLATFORM-SPECIFIC METHOD ===
Function GetMDataXML(ip As String) As String
    Dim os As String: os = Application.OperatingSystem

    ' macOS: use AppleScript shell call to curl
    If InStr(1, os, "Mac", vbTextCompare) > 0 Then
        Dim script As String
        script = "do shell script " & Chr(34) & "curl -s " & ip & Chr(34)
        On Error Resume Next
        GetMDataXML = MacScript(script)
        If Err.Number <> 0 Then GetMDataXML = ""

    ' Windows: use MSXML2.XMLHTTP request
    Else
        Dim http As Object
        Set http = CreateObject("MSXML2.XMLHTTP")
        On Error Resume Next
        http.Open "GET", ip, False
        http.Send
        If Err.Number = 0 And http.Status = 200 Then
            GetMDataXML = http.responseText
        Else
            GetMDataXML = ""
        End If
    End If
End Function