laatzen/Pruef2000/source/CRefzaehler.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CRefzaehler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
 Option Explicit

'lokale Variable(n) zum Zuweisen der Eigenschaft(en)
Private mvarSerienNr As Long 'lokale Kopie
Private mvarPruefstationNr As Long 'lokale Kopie
Private mvarEinbauplatzNr As Integer 'lokale Kopie
Private mvarZaehlerNr As Long 'lokale Kopie
Private mvarBaujahr As Date 'lokale Kopie
Private mvarEinbaudatum As Date 'lokale Kopie
Private mvarZaehlerTyp As String 'lokale Kopie
Private mvarNennweite As Long 'lokale Kopie
Private mvarImpulseQM As Long 'lokale Kopie

Private mvarMIDGruppe As String 'lokale Kopie
Private mvarODurchfluss As Double 'lokale Kopie
Private mvarUDurchfluss  As Double 'lokale Kopie

Private mvarDatumLetzterFehler As Date 'lokale Kopie
Private mvarTempLetzterFehler As Double 'lokale Kopie

Private mvarColPruefpunkte As Collection 'lokale Kopie


Public Property Get colPruefpunkte() As Collection
    Set colPruefpunkte = mvarColPruefpunkte
End Property


Public Property Let ImpulseQM(ByVal vData As Long)
    mvarImpulseQM = vData
End Property

Public Property Get ImpulseQM() As Long
    ImpulseQM = mvarImpulseQM
End Property

Public Property Let Nennweite(ByVal vData As Long)
    mvarNennweite = vData
End Property

Public Property Get Nennweite() As Long
    Nennweite = mvarNennweite
End Property

Public Property Let ZaehlerTyp(ByVal vData As String)
    mvarZaehlerTyp = vData
End Property

Public Property Get ZaehlerTyp() As String
    ZaehlerTyp = mvarZaehlerTyp
End Property

Public Property Let Einbaudatum(ByVal vData As Date)
    mvarEinbaudatum = vData
End Property

Public Property Get Einbaudatum() As Date
    Einbaudatum = mvarEinbaudatum
End Property

Public Property Let Baujahr(ByVal vData As Date)
    mvarBaujahr = vData
End Property

Public Property Get Baujahr() As Date
    Baujahr = mvarBaujahr
End Property

Public Property Let ZaehlerNr(ByVal vData As Long)
    mvarZaehlerNr = vData
End Property

Public Property Get ZaehlerNr() As Long
    ZaehlerNr = mvarZaehlerNr
End Property

Public Property Let EinbauplatzNr(ByVal vData As Integer)
    mvarEinbauplatzNr = vData
End Property

Public Property Get EinbauplatzNr() As Integer
    EinbauplatzNr = mvarEinbauplatzNr
End Property

Public Property Let PruefstationNr(ByVal vData As Long)
    mvarPruefstationNr = vData
End Property

Public Property Get PruefstationNr() As Long
    PruefstationNr = mvarPruefstationNr
End Property

Public Property Let SerienNr(ByVal vData As Long)
    mvarSerienNr = vData
End Property

Public Property Get SerienNr() As Long
    SerienNr = mvarSerienNr
End Property

Public Property Let ODurchfluss(ByVal vData As Double)
    mvarODurchfluss = vData
End Property

Public Property Get ODurchfluss() As Double
    ODurchfluss = mvarODurchfluss
End Property

Public Property Let UDurchfluss(ByVal vData As Double)
    mvarUDurchfluss = vData
End Property

Public Property Get UDurchfluss() As Double
    UDurchfluss = mvarUDurchfluss
End Property

Public Property Let MidGruppe(ByVal vData As String)
    mvarMIDGruppe = vData
End Property

Public Property Get MidGruppe() As String
    MidGruppe = mvarMIDGruppe
End Property

Public Function loadForDurchfluss(Durchfluss As Double, MidGruppe As Integer) As Boolean
Dim PruefstationNr As Integer
Dim sSQL As String
Dim rs   As CRecordset
Dim sMIDGruppe As String
   
sMIDGruppe = "A"
If MidGruppe = 2 Then
    sMIDGruppe = "B"
End If

'On Error GoTo loadForDurchflussErr

PruefstationNr = g_App.PruefstationNr


' Todo: Gruppe durch INI Datei voreingestellt:  MIDGruppe='A';"

sSQL = "SELECT * FROM Referenzzaehler "
sSQL = sSQL & "WHERE "
sSQL = sSQL & "ODurchfluss > " & ValueToSQLString(Durchfluss) & " and UDurchfluss <= " & ValueToSQLString(Durchfluss)
sSQL = sSQL & " AND PruefstationNr = " & PruefstationNr & " and MIDGruppe='" & sMIDGruppe & "';"
Debug.Print sSQL

    Set rs = New CRecordset
    If Not rs.openRS(sSQL) Then Exit Function
    
    If rs.EOF() Then Exit Function
    
    mvarSerienNr = rs.getLongValue("SerienNr")
    mvarPruefstationNr = rs.getLongValue("PruefstationNr")
    mvarEinbauplatzNr = rs.getIntValue("EinbauplatzNr")
    mvarZaehlerNr = rs.getLongValue("ZaehlerNr")
    mvarBaujahr = rs.getDateValue("Baujahr")
    mvarEinbaudatum = rs.getDateValue("Einbaudatum")
    mvarZaehlerTyp = rs.getStringValue("ZaehlerTyp")
    mvarNennweite = rs.getLongValue("Nennweite")
    mvarImpulseQM = rs.getLongValue("ImpulseQM")
    mvarMIDGruppe = rs.getStringValue("MIDGruppe")
    mvarODurchfluss = rs.getDoubleValue("ODurchfluss")
    mvarUDurchfluss = rs.getDoubleValue("UDurchfluss")
 
    Set rs = Nothing
    
    loadForDurchfluss = True
    Exit Function
    
loadForDurchflussErr:
    Call showError("loadForDurchfluss")
    Exit Function
End Function


Public Function loadForSerienNr(lSerienNr As Long) As Boolean
  Dim sSQL As String
    Dim rs   As CRecordset
    
    On Error GoTo loadErr
    
    sSQL = "SELECT * FROM Referenzzaehler "
    sSQL = sSQL & "WHERE "
    sSQL = sSQL & "SerienNr = " & lSerienNr
    sSQL = sSQL & ";"
    
    Set rs = New CRecordset
    If Not rs.openRS(sSQL) Then Exit Function
    
    If rs.EOF() Then Exit Function
    
    mvarSerienNr = rs.getLongValue("SerienNr")
    mvarPruefstationNr = rs.getLongValue("PruefstationNr")
    mvarEinbauplatzNr = rs.getIntValue("EinbauplatzNr")
    mvarZaehlerNr = rs.getLongValue("ZaehlerNr")
    mvarBaujahr = rs.getDateValue("Baujahr")
    mvarEinbaudatum = rs.getDateValue("Einbaudatum")
    mvarZaehlerTyp = rs.getStringValue("ZaehlerTyp")
    mvarNennweite = rs.getLongValue("Nennweite")
    mvarImpulseQM = rs.getLongValue("ImpulseQM")
    mvarMIDGruppe = rs.getStringValue("MIDGruppe")
    mvarODurchfluss = rs.getDoubleValue("ODurchfluss")
    mvarUDurchfluss = rs.getDoubleValue("UDurchfluss")
    
    Set rs = Nothing
        
    loadForSerienNr = True
    Exit Function
    
loadErr:
    Call showError("loadForSerienNr")
    Exit Function
End Function

Public Function IstOkFuerDurchfluss(Q As Double) As Boolean
    If mvarODurchfluss >= Q And mvarUDurchfluss < Q Then
        IstOkFuerDurchfluss = True
    Else
        IstOkFuerDurchfluss = False
    End If
End Function

Public Function LoadForRefzaehlerpruefung(EinbauplatzNr As Integer)
On Error GoTo LoadForRefzaehlerpruefungError
    Dim sSQL As String
    Dim rs As CRecordset
    Dim PruefstationNr As Integer
    
    Set rs = New CRecordset
    
    PruefstationNr = g_App.PruefstationNr
    
    sSQL = "SELECT * from Referenzzaehler where PruefstationNr=" & PruefstationNr & " and EinbauplatzNr=" & EinbauplatzNr & ";"
    If Not rs.openRS(sSQL) Then GoTo LoadForRefzaehlerpruefungError
    If rs.RecordCount = 1 Then
        mvarSerienNr = rs.getLongValue("SerienNr")
        mvarPruefstationNr = rs.getLongValue("PruefstationNr")
        mvarEinbauplatzNr = rs.getIntValue("EinbauplatzNr")
        mvarZaehlerNr = rs.getLongValue("ZaehlerNr")
        mvarBaujahr = rs.getDateValue("Baujahr")
        mvarEinbaudatum = rs.getDateValue("Einbaudatum")
        mvarZaehlerTyp = rs.getStringValue("ZaehlerTyp")
        mvarNennweite = rs.getLongValue("Nennweite")
        mvarImpulseQM = rs.getLongValue("ImpulseQM")
        mvarMIDGruppe = rs.getStringValue("MIDGruppe")
        mvarODurchfluss = rs.getDoubleValue("ODurchfluss")
        mvarUDurchfluss = rs.getDoubleValue("UDurchfluss")
        
        If Not LoadPruefpunkte() Then
            GoTo LoadForRefzaehlerpruefungError
        End If
        
        LoadForRefzaehlerpruefung = 0
    Else
        LoadForRefzaehlerpruefung = -1
    End If
Exit Function
LoadForRefzaehlerpruefungError:
   LoadForRefzaehlerpruefung = False
   ErrorMsg "Konnte RefZ.-Daten f<EFBFBD>r Einbauplatz " & EinbauplatzNr & " nicht laden: " & Err.Description
End Function

Public Function LoadPruefpunkte()
On Error GoTo LoadPruefpunkteError
    Dim Pruefpunkt As CRefZaehlerPruefpunkt
    Dim sSQL As String
    Dim rs As CRecordset
    
    sSQL = "SELECT * from ReferenzzaehlerPruefpunkt where SerienNr=" & mvarSerienNr & " "
    
    If g_blnVersuch Then
        ' Versuch
        sSQL = sSQL & " and Ausfuehren_Versuch=1 order by Durchfluss DESC;"
    Else
        ' Produktion
        sSQL = sSQL & " and Ausfuehren=1 order by Durchfluss DESC;"
    End If
    
    Set rs = New CRecordset
    Debug.Print sSQL
    
    rs.openRS (sSQL)
    Do While Not rs.EOF
        Set Pruefpunkt = New CRefZaehlerPruefpunkt
        Pruefpunkt.load SerienNr, rs.getIntValue("ID")
        mvarColPruefpunkte.Add Pruefpunkt
        Set Pruefpunkt = Nothing
        rs.MoveNext
    Loop
    LoadPruefpunkte = True
Exit Function
LoadPruefpunkteError:
ErrorMsg "Konnte Pr<EFBFBD>fpunkte f<EFBFBD>r RefZ " & mvarSerienNr & " nicht laden: " & Err.Description
End Function

Private Sub Class_Initialize()
    Set mvarColPruefpunkte = New Collection
End Sub

Public Function letzterFehlerString(Durchfluss As Double, Optional Temperatur As Double = 0) As String
On Error GoTo letzterFehlerError
Dim sSQL As String
Dim rs As CRecordset
Dim Msg As String

Dim Index As Integer
Dim feldprefix As String
Dim PP_Durchfluss As Double
Dim PP_Fehler As Double


mvarDatumLetzterFehler = 0
Set rs = New CRecordset

If Temperatur = 0 Then
    sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
    DebugMsg "Letzten Fehler des RefZ. " & mvarSerienNr & " ermitteln f<EFBFBD>r Q =" & Format(Durchfluss, "0.000")
Else
    DebugMsg "Letzten Fehler des RefZ. " & mvarSerienNr & " ermitteln f<EFBFBD>r Q =" & Format(Durchfluss, "0.000") & " und Temperatur=" & Format(Temperatur, "0.0") & " <EFBFBD>C"
    sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr
    If Temperatur < 40 Then
        ' Kaltwasser
        sSQL = sSQL & " and PP1_WasserTemp <= 40"
    ElseIf Temperatur < 70 Then
        ' Warmwasser
        sSQL = sSQL & " and PP1_WasserTemp > 40 and PP1_WasserTemp <= 70 "
    Else
        ' Heisswasser
        sSQL = sSQL & " and PP1_WasserTemp > 70 "
    End If
    
    sSQL = sSQL & " order by Datum DESC;"
End If
Debug.Print sSQL

rs.openRS (sSQL)

' Betrachte den n<>chsten Recordset vom neusten bis zum <20>ltesten
naechstesDatum:
        
If Not rs.EOF Then
    mvarDatumLetzterFehler = rs.getDateValue("Datum")
    mvarTempLetzterFehler = rs.getDoubleValue("PP1_WasserTemp")
    'DebugMsg "Betrachtung der RZFehler vom Datum: " & Format(mvarDatumLetzterFehler, "dd.mm.yyyy hh:mm") & ", T=" & Format(mvarTempLetzterFehler, "0.0")

    ' Schleife vom h<>chsten zum niedrigsten gepr<70>ften Durchfluss
    ' des Referenzzaehlers bei der lezten Referenzzaehlerpr<70>fung
    For Index = 1 To 10
        Debug.Print "Index: " & Index
        feldprefix = "PP" & CStr(Index)
                            
        PP_Durchfluss = Round(rs.getDoubleValue(feldprefix & "_Soll_Q"), 4)
        ' Fehler in %
        PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
        
        Debug.Print "PP_Durchfluss: " & PP_Durchfluss
        Debug.Print "PP_Fehler: " & PP_Fehler
        
        If Durchfluss = PP_Durchfluss Then
            letzterFehlerString = CStr(PP_Fehler)
            Exit Function
        End If
        ' Es darf nicht interpoliert werden
                
        If PP_Durchfluss < Durchfluss Then
            Exit For
        End If
        
        If PP_Durchfluss <= 0 Then
            Exit For
        End If
    Next
    Debug.Print "Es gibt keinen letzten Fehler f<EFBFBD>r Durchfluss " & PP_Durchfluss
    rs.MoveNext
    GoTo naechstesDatum
Else
    mvarDatumLetzterFehler = 0
    LogIntoDB "EOF ! Es konnt kein letzter Fehler in der DB gefunden werden.", "FM85 RZ Pr<EFBFBD>f"
End If

letzterFehlerError:
    If Msg = "" Then Msg = Err.Description
    If Err.Description <> "" Then
        LogIntoDB "Fehler " & Err.Number & " in letzterFehlerString(): " & Err.Description, "FM85 RZ Pr<EFBFBD>f"
    End If
    letzterFehlerString = ""
    mvarDatumLetzterFehler = 0
End Function

'
'Public Function InterpolierterFehler(Durchfluss As Double) As Double
'Dim sSQL As String
'Dim rs As CRecordset
'Dim PP_Nr As Integer
'Dim feldprefix As String
'Dim PP_Durchfluss As Double
'Dim PP_Fehler As Double
'Dim untererDurchfluss As Double
'Dim untererFehler As Double
'Dim obererDurchfluss As Double
'Dim obererFehler As Double
'Dim Phase As Integer
'
'    Phase = 1
'    Set rs = New CRecordset
'    sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
'    rs.openRS (sSQL)
'
'    obererDurchfluss = 0
'    Do While Not rs.EOF
'        PP_Nr = 1
'        Do While PP_Nr < 11
'            feldprefix = "PP" & CStr(PP_Nr)
'             Durchfluss absteigend
'            PP_Durchfluss = rs.getDoubleValue(feldprefix & "_Soll_Q")
'             Fehler in %
'            PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
'            If PP_Durchfluss = 0 Then
'                 Feld leer
'                Debug.Print "PP=0"
'                Exit Do
'            If PP_Durchfluss < Durchfluss Then
'                 PP_Durchfluss unterschreitet Durchfluss
'                 Suche in dieser Zeile abbrechen
'                Exit Do
'            Else
'                obererDurchfluss = PP_Durchfluss
'                obererFehler = PP_Fehler
'                PP_Nr = PP_Nr + 1
'            End If
'        Loop
'
'         n<>chste Zeile
'        rs.MoveNext
'    Loop
'
'    Debug.Print "leider alles durchsucht"
'    Exit Function
'Erfolg:
'
'
'
'TestePP:
'    If PP_Nr > 10 Then
'         diesen PP gibt es nicht
'        rs.MoveNext
'        If rs.EOF Then
'            Exit Function
'        End If
'
'        PP_Nr = 1
'        GoTo TestePP
'    End If
'
'    If PP_Durchfluss = 0 Then
'         keine weiteren PP in dieser Zeile
'        Debug.Print ("keine weiteren PP in dieser Zeile")
'        rs.MoveNext
'        If rs.EOF Then
'            PP_Nr = PP_Nr + 1
'            GoTo TestePP
'        End If
'    End If
'    Debug.Print "================================"
'    Debug.Print "Durchfluss:" & Durchfluss
'    Debug.Print "PP_Nr: " & PP_Nr
'    Debug.Print "PP_Durchfluss: " & PP_Durchfluss
'    Debug.Print "PP_Fehler: " & PP_Fehler
'
'    If PP_Durchfluss = Durchfluss Then
'         OK. Wir haben ihn
'        InterpolierterFehler = PP_Fehler
'        Exit Function
'    End If
'
'    If PP_Durchfluss > Durchfluss Then
'        obererDurchfluss = PP_Durchfluss
'        obererFehler = PP_Fehler
'         Testen, ob es noch einen kleineren gibt
'        PP_Nr = PP_Nr + 1
'        GoTo TestePP
'    End If
'
'     Nein, der n<>chste PP war bereits kleiner als der Durchfluss
'    Debug.Print "PP ist kleiner als D"
'
'    Phase 1: Finde den neusten kleinsten PP, der gerade noch gr<67><72>er ist als Durchfluss
'    Phase 2: Finde den neusten gr<67><72>ten PP, der gerade noch kleiner ist als Durchfluss
'
'    PP_Nr = 1
'    feldprefix = "PP" & CStr(PP_Nr)
'    ' Durchfluss absteigend
'
'    PP_Durchfluss = rs.getDoubleValue(feldprefix & "_Soll_Q")
'    ' Fehler in %
'    PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
'
'    If PP_Durchfluss > Durchfluss Then
'        ' gr<67><72>eren Durchfluss gefunden,
'        ' <20>berpr<70>fen, ob es noch einen kleinerern gibt, der gr<67><72>er ist
'        PP_Nr = PP_Nr + 1
'        GoTo UeberpruefeDurch
'    End If
'
'
'
'        'PP_Durchfluss als oberer Wert zum Interpolieren verwenden
'        obererDurchfluss = PP_Durchfluss
'
'
'
'
'
'ErsterPP:
'
'    If PP_Durchfluss = Durchfluss Then
'        InterpolierterFehler = PP_Fehler
'        Exit Function
'    End If
'
'    If Durchfluss > PP_Durchfluss Then
'        ' Durchfluss des ersten PP ist schon kleiner als der Durchfluss
'        ' (gr<67><72>er als interpolierbarer Bereich)
'        ' also n<>chster RZ-Pr<50>fgang
'        rs.MoveNext
'        If rs.EOF Then
'            ' Es gibt keine weiteren Pr<50>fg<66>nge mehr
'            GoTo InterpolierterFehlerError
'        End If
'        GoTo ErsterPP
'    End If
'
'    ' PP_Durchfluss > Durchfluss , also unteren Durchfluss merken
'    untererDurchfluss = PP_Durchfluss
'    untererFehler = PP_Fehler
'
'' n<>chsten PP in der Zeile betrachten:
'naechsterPP:
'    PP_Nr = PP_Nr + 1
'    feldprefix = "PP" & CStr(PP_Nr)
'
'    PP_Durchfluss = rs.getDoubleValue(feldprefix & "_Soll_Q")
'    ' Fehler in %
'    PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
'    Debug.Print "PP_Durchfluss: " & PP_Durchfluss
'    Debug.Print "PP_Fehler: " & PP_Fehler
'
'    If PP_Durchfluss < Durchfluss Then
'        GoTo naechsterPP
'    End If
'''''''''''''''
'    ' unteren Durchfluss merken
'    untererDurchfluss = PP_Durchfluss
'    untererFehler = PP_Fehler
'
'
'
'
'
'
'
'    Exit Function
'
'InterpolierterFehlerError:
'    MsgBox ("Der Fehler des Referenzz<EFBFBD>hlers bei Q=" & Durchfluss & " konnte nicht bestimmt werden")
'    InterpolierterFehler = 0
'End Function


' Ermittelt und interpoliert den Fehler eines Referenzz<7A>hlers
' bei einem gegebenen Durchfluss unter Verwendung der Pr<50>fergebnisse der
' letzten Referenzz<7A>hlerpr<70>fung
Public Function letzterFehler(Durchfluss As Double, Optional Temperatur As Double = 0) As Double
On Error GoTo letzterFehlerError
Dim sSQL As String
Dim rs As CRecordset
Dim Msg As String

Dim Index As Integer
Dim feldprefix As String
Dim PP_Durchfluss As Double
Dim PP_Fehler As Double

Dim obererDurchfluss As Double
Dim obererFehler As Double

Set rs = New CRecordset
mvarDatumLetzterFehler = 0

If Temperatur = 0 Then
    sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
    'DebugMsg "Letzten Fehler des RefZ. ermitteln f<EFBFBD>r Q =" & Durchfluss
Else
    'DebugMsg "Letzten Fehler des RefZ. ermitteln f<EFBFBD>r Q =" & Durchfluss & " und Temperatur=" & Temperatur & " <EFBFBD>C"
    sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr
    If Temperatur <= 40 Then
        ' Kaltwasser
        sSQL = sSQL & " and PP1_WasserTemp <= 40"
    ElseIf Temperatur < 70 Then
        ' Warmwasser
        sSQL = sSQL & " and PP1_WasserTemp > 40 and PP1_WasserTemp <= 70 "
    Else
        ' Heisswasser
        sSQL = sSQL & " and PP1_WasserTemp > 70 "
    End If
    
    sSQL = sSQL & " order by Datum DESC;"
End If


rs.openRS (sSQL)
' Betrachte den n<>chsten Recordset vom neusten bis zum <20>ltesten
naechstesDatum:
        obererFehler = 0
        obererDurchfluss = 0
If Not rs.EOF Then
        mvarDatumLetzterFehler = rs.getDateValue("Datum")
        Debug.Print "letztes RZ-Pr<EFBFBD>fdatum:" & Format(mvarDatumLetzterFehler, "dd.mm.yyyy hh:mm") & "  f<EFBFBD>r RZ-" & mvarMIDGruppe
        
    ' Schleife vom h<>chsten zum niedrigsten gepr<70>ften Durchfluss
    ' des Referenzzaehlers bei der lezten Referenzzaehlerpr<70>fung
    For Index = 1 To 10
        'Debug.Print "Index: " & Index
        feldprefix = "PP" & CStr(Index)
                            
        PP_Durchfluss = Round(rs.getDoubleValue(feldprefix & "_Soll_Q"), 4)
        'Debug.Print "Q= " & PP_Durchfluss
        ' Fehler in %
        PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
        
        If Durchfluss = PP_Durchfluss Then
            letzterFehler = PP_Fehler
            Exit Function
        End If
        
        ' Nur wenn folgende Bedingung erf<72>llt wird, darf interpoliert werden
        If obererDurchfluss > Durchfluss And Durchfluss > PP_Durchfluss And PP_Durchfluss > 0 Then
            letzterFehler = obererFehler - ((obererDurchfluss - Durchfluss) * _
            (obererFehler - PP_Fehler) / (obererDurchfluss - PP_Durchfluss))
            
            Debug.Print "letzter Fehler durch Interpolation:  " & obererDurchfluss _
               & " u. " & Durchfluss & " u." & PP_Durchfluss & " entspricht  " & obererFehler _
               & " u. " & letzterFehler & " u. " & PP_Fehler
            Exit Function
        End If
        
        If PP_Durchfluss < Durchfluss Then
            Exit For
        End If
        
        If PP_Durchfluss <= 0 Then
            Exit For
        End If
        
        ' merke Werte des letzen Schleifendurchgangs
        ' f<>r n<>chsten Schleifendurchgang
        obererFehler = PP_Fehler
        obererDurchfluss = PP_Durchfluss
    Next
    Debug.Print "PP mit Q=" & Durchfluss & " liegt ausserhalb des interpolierbaren Bereiches. N<EFBFBD>chst <EFBFBD>ltere RefZPr<EFBFBD>fung wird herangezogen"
    rs.MoveNext
    GoTo naechstesDatum
Else
    mvarDatumLetzterFehler = 0
    Debug.Print "EOF !"
    Msg = "Es konnte kein Fehler des Referenzz<EFBFBD>hlers aus der DB ermittelt werden. Bitte geben Sie den letzen Fehler des Referenzz<EFBFBD>hlers beim Durchflu<EFBFBD> " & Durchfluss & " ein."
End If
letzterFehlerError:
If Msg = "" Then Msg = Err.Description
'letzterFehler = CDbl(InputBox(Msg, "", 0))
letzterFehler = -99
mvarDatumLetzterFehler = 0
End Function

Public Function DatumDesFehlers() As Date
    DatumDesFehlers = mvarDatumLetzterFehler
End Function

Public Function TempDesFehlers() As Double
    TempDesFehlers = mvarTempLetzterFehler
End Function

' Ermittelt das Datum der letzten Pr<50>fung
Public Function letztePruefung() As Date
On Error GoTo letztePruefungError
Dim sSQL As String
Dim rs As CRecordset
    
    Set rs = New CRecordset
    
    sSQL = "SELECT Datum from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
    rs.openRS (sSQL)
    ' Betrachte nur den ersten Recordset mit dem neusten Datum
    If Not rs.EOF Then
        letztePruefung = rs.getDateValue("Datum")
    Else
        MsgBox ("Referenzzaehler.letztePruefung: kein Datensatz vorhanden")
    End If
Exit Function
letztePruefungError:

End Function