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