Sartorius
Sartorius Waagen auslesen
- Der Messwert der Waage wird in die aktive Zelle eingetragen.
- Die in der ListBox markierten Spalten werden nacheinander angesprungen
- Nach der letzten in der ListBox markierten Spalte wird die erste markierte Spalte in der nächsten Zeile angesprungen.
Details
Hardware
= |
+ |
|
||
Sartorius Kabel für RS232 Waagenausgang |
D-SUB Adapterkabel 9-pol./25-pol., BU/ST Belegung: 1-8 2-3 3-2 4-20 5-7 6-6 7-4 8-5 9-22 |
Jumper-Box, RS232, 25-pol. ST/BU |
||
ca. 115 EUR | ca. 1,50 EUR | ca. 1,50 EUR | ||
7357314 | AK 125 | COM 972 |
Verbindungsplan
[PC ST] - 9 pol - [BU Adapterkabel ST] - 25 pol - [BU Jumber Box ST] - 25 pol - [BU Sartorius Waage]
Adapterkabel Jumper Box 1 - 8 2 - 3 3 - 2 3 - 2 2 - 3 4 - 20 20 - 5 5 - 7 7 - 4, 7, 15 6 - 6 6 - 20 7 - 4 8 - 5 5 - 20 9 - 22
Software
Sartorius - YSC02 SartoCollect Software ca 589 EUR. Alternativ: OpenSource Serial Port Communication in Excel (VBA). Das Excel Add-in sartorius.xla (beta)
Polling
Option Explicit Dim CommStop As Boolean Public Sub Sartorius() UserForm1.Show vbModeless End Sub Public Sub setCommStop(b As Boolean) CommStop = b End Sub Sub springe_weiter() Dim i As Integer Dim R As Range Set R = ActiveCell ' springe zur nächsten in der Liste markierten Zelle For i = R.Column To UserForm1.ListBox1.ListCount - 1 If UserForm1.ListBox1.Selected(i) Then Set R = Cells(R.Row, i + 1) R.Select Exit Sub End If Next i ' springe zur ersten in der Liste markierten Zelle in der nächsten Zeile For i = 0 To UserForm1.ListBox1.ListCount - 1 If UserForm1.ListBox1.Selected(i) Then Set R = Cells(R.Row + 1, i + 1) R.Select Exit Sub End If Next i End Sub Public Sub PollCom() If CommStop Then Exit Sub Static sInput As String Dim InputData As String Dim lngStatus As Long lngStatus = CommRead(UserForm1.getintPortID, InputData, 50) Debug.Print InputData sInput = sInput & InputData If Len(sInput) >= 15 Then sInput = Application.WorksheetFunction.Clean(Trim(sInput)) sInput = Replace(sInput, "N", "") sInput = Replace(sInput, "+", "") sInput = Replace(sInput, "[", "") sInput = Replace(sInput, "]", "") sInput = Replace(sInput, "kg", "") sInput = Replace(sInput, "g", "") ActiveCell.value = sInput springe_weiter sInput = "" End If Application.OnTime Now + TimeValue("00:00:01"), "PollCom" End Sub
Formular
Option Explicit Dim intPortID As Integer Public Function getintPortID() As Integer getintPortID = intPortID End Function Private Sub UserForm_Initialize() Dim s Dim arr arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", _ "J", "K", "L", "M", "N", "O", "P") For Each s In arr ListBox1.AddItem s Next s End Sub Private Sub CommandButtonStop_Click() Modul3.setCommStop (True) Call CommClose(intPortID) End Sub Private Sub CommandButtonStart_Click() Modul3.setCommStop (False) Dim lngStatus As Long intPortID = 1 Call CommClose(intPortID) lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _ "baud=1200 parity=o data=7 stop=1") Call PollCom End Sub
Workbook_Open
Option Explicit Private Sub Workbook_Open() Dim cmdBarButton As CommandBarButton On Error Resume Next Application.CommandBars("Standard").Controls("Sartorius Waage").Delete On Error GoTo 0 Set cmdBarButton = Application.CommandBars("Standard"). _ Controls.Add(Type:=msoControlButton, Temporary:=True) With cmdBarButton .Caption = "Sartorius Waage" .OnAction = "Sartorius" .BeginGroup = True .FaceId = 283 .Style = msoButtonIconAndCaption .TooltipText = "Sartorius Waage" .Tag = "Sartorius Waage" End With End Sub