Hielscher Sonicator XMLデータ用リアルタイムExcelロガー
このHielscherソニケーター用リアルタイムエクセルロガーは、XMLフォーマットでストリーミングされるライブ超音波データを視覚化できる、VBAベースの軽量ソリューションです。ローカルIP経由でソニケーターに自動的に接続し、ライブプロセスデータを読み出し、エクセルの表に記録し、ダイナミックチャートを更新します。これにより、ユーザーはパワー、振幅、エネルギー、温度などの主要パラメータをリアルタイムで、Excel内で直接モニターすることができます。
仕組み
スクリプトを実行すると、ソニケーターxmlデータのXMLソースアドレス(例：http://192.168.233.233/mdata.xml)の入力を求めるプロンプトが表示される。その後、構造化されたヘッダー行を作成し、1秒ごとにデータのフェッチを開始する。各新しいデータポイントが表に追加され、散布線グラフがパワー、振幅、エネルギーの経時的傾向を表示します。センサーのエラー値（センサーが接続されていない場合など）は自動的にフィルタリングされる。
Windowsユーザー向け説明書
ExcelでVisual Basic Editorを開き、新しいモジュールを挿入し、完全なスクリプトを貼り付けます。InitLogger マクロを実行すると、ロガーが自動的に開始します。マクロが有効になっており、Excel にネットワークへのアクセス権限があることを確認します。
macOSユーザー向け説明書
ExcelでVisual Basic Editorを開く。新しいモジュールを挿入し、完全なスクリプトを貼り付ける。同じマクロを実行するだけで、提供されたIPを使ってデータが取得されます。MacOSユーザーは、ExcelがAppleScriptを実行することを許可する必要があり、プロンプトが表示されたら、システム環境設定でネットワークアクセスを許可する必要があるかもしれません。
ソニケーター XML データをスプレッドシートに読み込む Excel VBA コードを実行する。
アップデート、免責事項、ライセンス
デバイスのタイプや提供されるソフトウェアのバージョンによって、xmlデータストリングは異なる場合があります。xmlデータ文字列は、異なる順序や形式で、異なる数の値を含むかもしれません。従って、それに応じて以下のスクリプトを調整する必要があるかもしれません。技術サポート、バグフィックス、将来のアップデートの義務はありません。このツールは、いかなる種類の保証も保証もなく提供されます。これは、商品性や特定目的への適合性のような黙示の保証を明確に除外するものです。Hielscher Ultrasonicsは、本ソフトウェアの使用から生じる直接的、間接的、結果的な損害を含むいかなる損害に対しても責任を負いません。これは一例です。非商用および研究目的でのみ自由に使用できます。再配布は、適切な帰属表示があれば許可されます。書面による事前の同意なしに、商業的な再販や専有システムに含めることは固く禁じられています。
Sonicator XMLデータから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