Access Blog

Bei der manuellen Messwerterfassung hat man immer die Unsicherheit des Faktors „Mensch“ zu berücksichtigen. Zahlendreher oder zuviele Nullen sind da schnell mal eingegeben, und im Nachhinein schwer zu finden. Da ist es besser man macht eine Plausibilitätsprüfung indem man das Formular ungebunden macht und bei klick auf den Speicherbutton die Eingabewerte überprüft.

Z.B. auf die Anzahl der Stellen, ob positiv oder negativ, ob größer oder kleiner von einem bestimmten Wert, oder ob in einem bestimmten Zahlenbereich liegend.

Das Problem daran ist, dass sich diese Begrenzungen ständig ändern können. Dann muss man den VBA-Code durchsuchen wo man diese Plausibilitätsprüfung gemacht hat. Besser wäre das doch wenn man in einer Tabelle alle Plausibilitäten einfach ablegen könnte von wo aus sie einfach zu administrieren sind. Und genau das wollen wir jetzt machen.

Zuerst die Tabelle.
Jeder Messwert hat eine bestimmte Nummer oder Namen. Außerdem benötigen wird ein Vergleichsmuster, und eine Werteliste mit den einzelnen Werten gegen den der Messwert abgeprüft wird.

Ein Datensatz in dieser Tabelle sieht z.B. so aus:

ID	Bezeichner	Muster	Werteliste
1	MP1	> {1} AND <= {2} AND <> {3}	2;5;4

Im Muster sieht man Platzhalter in geschweiften Klammern stehen, diese werden dann mit den Werten aus der Werteliste ergänzt.

Hat man am Messpunkt MP1 einen Wert von z.B. 3 angegeben, so muss dieser in das Muster eingefügt werden, und der komplette Ausdruck mittels eval() geprüft werden.

Im ersten Schritt werden die Werte aus der Werteliste eingefügt;

    Set db = CurrentDb
    Set rs = db.OpenRecordset("Select * From tbl_Plausibilitäten", dbOpenDynaset)
    For i = 1 To 5
        rs.FindFirst "Bezeichner = 'MP" & i & "'"
        If Not rs.NoMatch Then
            ctlWert = Replace(Me("MP" & i).Value, ",", ".")
            bolAusdruck = ctlWert & " " & rs!Muster

            tmpSplit = Split(rs!Werteliste, ";")
            For k = 1 To UBound(tmpSplit) + 1
                bolAusdruck = Replace(bolAusdruck, "{" & k & "}", tmpSplit(k - 1))
            Next k

ctlWert ist der eingegebene Messwert. Da dieser auch Komma-Zahlen enthalten kann ist das Komma in einen Punkt umzuwandeln, sonst funktioniert später die Auswertung nicht.

Danach wird der aktuelle Messwert am Messpunkt MPi in den Ausdruck bolAusdruck eingefügt:

            For k = 1 To UBound(tmpSplit)
                posA = InStr(pos, LCase(bolAusdruck), "and")
                posB = InStr(pos, LCase(bolAusdruck), "or")
                If posA <= posB And posA > 0 Or posB = 0 Then
                    pos = posA + 4
                Else
                    pos = posB + 3
                End If
                bolAusdruck = Left(bolAusdruck, pos - 1) & ctlWert & " " & Mid(bolAusdruck, pos)
            Next k

Der Messwert muss nach dem And bzw. Or – mit dem mehrere Ausdrücke verkettet werden – eingefügt werden, daher wird 4 bzw 3 Zeichenlängen zur Position hinzugefügt. Die Position pos ist im nächsten Schleifendurchlauf die Startposition um weitere Verknüpfungsoperatoren zu finden und nach denen der Messwert einzufügen.

Nun ist der Bool’sche Ausdruck bolAusdruck komplett und kann auf Richtigkeit geprüft werden. Wie oben schon gesagt verwendet man dazu die Funktion Eval().

            If Not Eval(bolAusdruck) Then
                MsgBox "Messwert am Messpunkt " & i & " ist nicht Plausibel!"
                Exit Sub
            End If

Fehlt noch zum Schluss die eigentliche Speicherung der Messwerte per Einfügeabfrage. Und dabei gibt es auch noch einen Fallstrick der es zu beachten gilt.
Die Werte der Abfrage stehen in einer Komma-Separierten Liste. Wenn nun davon ein Messwert ebenfalls ein Komma hat, wirft VBA die Fehlermeldung heraus, dass die Anzahl der Abfragefelder und Zielfelder nicht übereinstimmen. Daher sind Werte mit Komma umzuwandeln wobei das Komma durch einen Punkt ersetzt wird, wie oben bei ctlWert.

        Me("MP" & i).Value = Replace(Me("MP" & i).Value, ",", ".")
    Next i
    
    'Messwerte speichern
    db.Execute "Insert into tbl_Messwerte (MP1, MP2, MP3, MP4, MP5) Values (" & Me!MP1 & ", " & Me!MP2 & ", " & Me!MP3 & ", " & Me!MP4 & ", " & Me!MP5 & ")"

Nun haben wir die Prozedur komplett, bis auf die Deklaration und Initialisation der Variablen.
Die komplette Prozedur sieht wie folgt aus:

Private Sub Speichern_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Long, k As Long, pos As Long, posA As Long, posB As Long
    Dim Messwert As Double
    Dim bolAusdruck As String, ctlWert As String, Operator As String
    Dim tmpSplit As Variant
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Select * From tbl_Plausibilitäten", dbOpenDynaset)
    For i = 1 To 5
        rs.FindFirst "Bezeichner = 'MP" & i & "'"
        If Not rs.NoMatch Then
            ctlWert = Replace(Me("MP" & i).Value, ",", ".")
            tmpSplit = Split(rs!Werteliste, ";")
            bolAusdruck = ctlWert & " " & rs!Muster
            pos = 1
            For k = 1 To UBound(tmpSplit) + 1
                bolAusdruck = Replace(bolAusdruck, "{" & k & "}", tmpSplit(k - 1))
            Next k
            
            For k = 1 To UBound(tmpSplit)
                posA = InStr(pos, LCase(bolAusdruck), "and")
                posB = InStr(pos, LCase(bolAusdruck), "or")
                If posA <= posB And posA > 0 Or posB = 0 Then
                    pos = posA + 4
                Else
                    pos = posB + 3
                End If
                bolAusdruck = Left(bolAusdruck, pos - 1) & ctlWert & " " & Mid(bolAusdruck, pos)
            Next k
            
            If Not Eval(bolAusdruck) Then
                MsgBox "Messwert am Messpunkt " & i & " ist nicht Plausibel!"
                Exit Sub
            End If
        End If
        Me("MP" & i).Value = Replace(Me("MP" & i).Value, ",", ".")
    Next i
    
    'Messwerte speichern
    db.Execute "Insert into tbl_Messwerte (MP1, MP2, MP3, MP4, MP5) Values (" & Me!MP1 & ", " & Me!MP2 & ", " & Me!MP3 & ", " & Me!MP4 & ", " & Me!MP5 & ")"
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub