946 lines
36 KiB
QBasic
946 lines
36 KiB
QBasic
Attribute VB_Name = "modDruck"
|
|
Option Explicit
|
|
|
|
Global g_strText As String
|
|
|
|
Global g_PrintFilePath As String
|
|
Private Const RAND = 7
|
|
|
|
Private mdblLinkerRand As Double
|
|
Private mdblRechterRand As Double
|
|
Private mdblObererRand As Double
|
|
Private mdblUntererRand As Double
|
|
|
|
|
|
Private ZEILEN_PRO_SEITE As Integer
|
|
Private MAXPPPROSPALTE As Integer
|
|
|
|
Public Sub initPrint(PrintFilePath As String)
|
|
' Initialisierung des Druckvorgangs
|
|
' geht davon aus, daß Printer angeschlossen ist
|
|
' Setzt alternative Datei
|
|
Err.Clear
|
|
Printer.Font.Name = "Courier New"
|
|
Printer.Font.Size = 9
|
|
|
|
g_PrinterOK = True
|
|
If Err Then
|
|
g_PrinterOK = False
|
|
End If
|
|
g_PrintFilePath = PrintFilePath
|
|
End Sub
|
|
|
|
Public Sub PrintString(sText As String)
|
|
On Error Resume Next
|
|
Dim PrintFilePath As String
|
|
Dim PrintFileHandle As Integer
|
|
|
|
If g_PrinterOK = True Then
|
|
Printer.Print sText
|
|
End If
|
|
If Err.Number <> 0 Or g_PrinterOK = False Then
|
|
Err.Clear
|
|
PrintFileHandle = FreeFile
|
|
Open g_PrintFilePath For Append As PrintFileHandle
|
|
Print #PrintFileHandle, sText
|
|
Close #PrintFileHandle
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub PrintEnd()
|
|
If g_PrinterOK Then
|
|
Printer.EndDoc
|
|
End If
|
|
End Sub
|
|
|
|
Public Function FormatSpace(myText As String, mySpace As Integer) As String
|
|
If myText = "" Then myText = " "
|
|
FormatSpace = Format(myText, Left("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@", mySpace))
|
|
End Function
|
|
|
|
|
|
'Public Sub RefZDruck_alt(Timestamp As Date, colRefZ As Collection, Optional Temperatur As Double = 0)
|
|
'
|
|
'
|
|
'On Error GoTo Errorhandler
|
|
'
|
|
'Dim StrDate As String
|
|
'Dim i As Integer
|
|
'Dim j As Integer
|
|
'
|
|
'Dim RefZaehlerA As CRefzaehler
|
|
'Dim RefZaehlerB As CRefzaehler
|
|
'
|
|
'Dim colPruefpunkte As Collection
|
|
'Dim RefZPruefpunkt As CRefZaehlerPruefpunkt
|
|
'
|
|
'Dim Zeile1 As String
|
|
'Dim Zeile2 As String
|
|
'
|
|
'Dim sDruck As String
|
|
'Dim Pruefdatum As Date
|
|
'
|
|
'Call initPrint(g_App.Settings.PrintDir & Format(Now(), "RZ-yyyy-mm-dd--hhmm") & ".txt")
|
|
'
|
|
'sDruck = ""
|
|
'
|
|
'sDruck = sDruck & Space(RAND) & "--------------------------------------------------------------" & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & " Referenzzählerfehler " & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & " (für die nächsten Hauptprüfungen zu verwenden) " & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & "--------------------------------------------------------------" & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & "Datum: " & Format(Timestamp, "dd.mm.yyyy hh.mm") & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & "Prüfer: " & g_App.Mitarbeiter.getName & " (" & g_App.Mitarbeiter.getNr & ")" & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & "Prüfstation: " & g_App.PruefstationNr & vbCrLf
|
|
'
|
|
'If Temperatur < 40 Then
|
|
' sDruck = sDruck & Space(RAND) & "Temperatur: Kalt < 40°C " & vbCrLf
|
|
'ElseIf Temperatur < 70 Then
|
|
' sDruck = sDruck & Space(RAND) & "Temperatur: Warm 40°C - 70°C " & vbCrLf
|
|
'Else
|
|
' sDruck = sDruck & Space(RAND) & "Temperatur: Heiss > 70°C " & vbCrLf
|
|
'End If
|
|
'
|
|
'sDruck = sDruck & Space(RAND) & vbCrLf
|
|
'sDruck = sDruck & Space(RAND) & vbCrLf
|
|
'
|
|
'For i = 0 To 3 ' für alle Stränge
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & vbCrLf
|
|
'
|
|
' ' Reinhard Henning 27.07.2004: auf Index Überschreitung prüfen
|
|
' On Error Resume Next
|
|
'
|
|
' Set RefZaehlerA = Nothing
|
|
' Set RefZaehlerB = Nothing
|
|
'
|
|
' If g_App.Settings.getAnzahlMIDGruppen > 1 Then
|
|
'
|
|
' Set RefZaehlerA = colRefZ.Item(i * 2 + 1)
|
|
' If Err.Number = 9 Then
|
|
' 'Index nicht vorhanden
|
|
' Debug.Print "Index für RZ-A nicht vorhanden:" & i * 2 + 1
|
|
' End If
|
|
' Err.Clear
|
|
'
|
|
' 'Index nicht vorhanden
|
|
' Set RefZaehlerB = colRefZ.Item(i * 2 + 2)
|
|
' If Err.Number = 9 Then
|
|
' 'Index nicht vorhanden
|
|
' Debug.Print "Index für RZ-B nicht vorhanden:" & i * 2 + 2
|
|
' End If
|
|
' Err.Clear
|
|
'
|
|
' Else
|
|
' Set RefZaehlerA = colRefZ.Item(i + 1)
|
|
' If Err.Number = 9 Then
|
|
' 'Index nicht vorhanden
|
|
' Debug.Print "Index für RZ (A) nicht vorhanden:" & i + 1
|
|
' End If
|
|
' End If
|
|
'
|
|
' On Error GoTo Errorhandler
|
|
'
|
|
' If Not RefZaehlerA Is Nothing Then
|
|
' Set colPruefpunkte = RefZaehlerA.colPruefpunkte
|
|
' Else
|
|
' Set colPruefpunkte = Nothing
|
|
' End If
|
|
'
|
|
' If Not colPruefpunkte Is Nothing Then
|
|
' If colPruefpunkte.Count > 0 Then
|
|
' ' Wegen des Prüfdatums schon mal den letzten Fehler nachschauen
|
|
' RefZaehlerA.letzterFehlerString colPruefpunkte(1).Durchfluss, Temperatur
|
|
' Pruefdatum = RefZaehlerA.DatumDesFehlers
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "|-" & FormatSpace("------", 6) & "---"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "---"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-|" & vbCrLf
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "| Nennweite: " & FormatSpace(RefZaehlerA.Nennweite, 3) & " |" & vbCrLf
|
|
'
|
|
' If Pruefdatum = 0 Then
|
|
' sDruck = sDruck & Space(RAND) & "| " & Space(18) & "|" & vbCrLf
|
|
' Else
|
|
' sDruck = sDruck & Space(RAND) & "| Geprüft: " & Format(Pruefdatum, "dd.mm.yyyy hh:mm") & " |" & vbCrLf
|
|
' End If
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "|Temperatur: " & Format(RefZaehlerA.TempDesFehlers, "0") & "°C |" & vbCrLf
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "|-" & FormatSpace("------", 6) & "-+-"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-+-"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-|" & vbCrLf
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "| " & FormatSpace("m³/h", 6) & " | "
|
|
' sDruck = sDruck & FormatSpace(RefZaehlerA.SerienNr, 9) & " | "
|
|
'
|
|
' If g_App.Settings.getAnzahlMIDGruppen > 1 Then
|
|
' If Not RefZaehlerB Is Nothing Then
|
|
' sDruck = sDruck & FormatSpace(RefZaehlerB.SerienNr, 9) & " |" & vbCrLf
|
|
' End If
|
|
' Else
|
|
' sDruck = sDruck & FormatSpace("", 9) & " |" & vbCrLf
|
|
' End If
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "|-" & FormatSpace("------", 6) & "-+-"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-+-"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-|" & vbCrLf
|
|
'
|
|
' For Each RefZPruefpunkt In colPruefpunkte
|
|
' sDruck = sDruck & Space(RAND) & "| " & FormatSpace(Format(RefZPruefpunkt.Durchfluss, "Fixed"), 6) & " | "
|
|
' sDruck = sDruck & FormatSpace(Format(RefZaehlerA.letzterFehlerString(RefZPruefpunkt.Durchfluss), "0.0"), 9) & " | "
|
|
'
|
|
' If g_App.Settings.getAnzahlMIDGruppen > 1 And Not RefZaehlerB Is Nothing Then
|
|
' sDruck = sDruck & FormatSpace(Format(RefZaehlerB.letzterFehlerString(RefZPruefpunkt.Durchfluss), "0.0"), 9) & " |" & vbCrLf
|
|
' Else
|
|
' sDruck = sDruck & FormatSpace("", 9) & " |" & vbCrLf
|
|
' End If
|
|
' Next
|
|
'
|
|
' sDruck = sDruck & Space(RAND) & "|-" & FormatSpace("------", 6) & "-+-"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-+-"
|
|
' sDruck = sDruck & FormatSpace("---------", 9) & "-|" & vbCrLf
|
|
' End If
|
|
' End If
|
|
'Next
|
|
'
|
|
'
|
|
'Printer.Font.Name = "Courier New"
|
|
'Printer.Print sDruck
|
|
'
|
|
'If Err <> 0 Then
|
|
' PrintString vbCrLf & vbCrLf & Err.Description
|
|
'End If
|
|
'
|
|
'Printer.EndDoc
|
|
'
|
|
'''Nennweite 125
|
|
'''SerrienNr.: 9000024
|
|
''
|
|
'' Durchfluss Fehler
|
|
'' ---------------------
|
|
'' 30 1.1%
|
|
'' 3 1.1%
|
|
'' 0.3 1.1%
|
|
''
|
|
''
|
|
''Nennweite 125
|
|
''MidGr: A
|
|
''SerrienNr.: 9000024
|
|
''
|
|
'' Durchfluss Fehler
|
|
'' ---------------------
|
|
'' 30 1.1%
|
|
'' 3 1.1%
|
|
'' 0.3 1.1%
|
|
'
|
|
'
|
|
'
|
|
'
|
|
'
|
|
' ' Datenvergleich Berechnung nach W2/k2 v. 9/48 durchführen und wenn > XX melden
|
|
' ' Wenn Wert abweicht, dann Wert drucken: Warnung ins Druckprotokoll
|
|
'
|
|
'' If (Abs(FehlerA - letzterFehlerA) / letzterFehlerA) * 100 > 0.2 Then
|
|
'' PrinterMsg "Warnung: Abweichung zw. den Fehlern von RZ-A: (alt: " & Format(letzterFehlerA, "0.000") & ", neu: " & Format(FehlerA, "0.000") & ") = > 0.2 %"
|
|
'' End If
|
|
''
|
|
'' If (Abs(FehlerB - letzterFehlerB) / letzterFehlerB) * 100 > 0.2 Then
|
|
'' PrinterMsg "Warnung: Abweichung zw. den Fehlern von RZ-B: (alt: " & Format(letzterFehlerB, "0.000") & ", neu: " & Format(FehlerB, "0.000") & ") = > 0.2 %"
|
|
'' End If
|
|
''
|
|
'' PrinterMsg " ----------------------------------------------- "
|
|
'' PrinterMsg "| Referenzzähler Prüfung |"
|
|
'' PrinterMsg " ----------------------------------------------- "
|
|
'' PrinterMsg " Datum, Zeit: " & Format(TimeStamp, "dd.mm.yyyy hh:mm")
|
|
'' PrinterMsg " Prüfer: " & g_App.Mitarbeiter.getName & " (" & g_App.Mitarbeiter.getNr & ")"
|
|
'' PrinterMsg " MID Gruppe: " & IIf(g_App.Settings.getMIDGruppe = 2, "B", "A")
|
|
'' PrinterMsg ""
|
|
'' PrinterMsg "Nennweite des Stranges: " & Referenzzaehler.Nennweite
|
|
'' PrinterMsg "Referenzzähler A SNr: " & m_ReferenzzaehlerA.SerienNr
|
|
'' PrinterMsg " Impulswertigkeit: " & m_ReferenzzaehlerB.ImpulseQM
|
|
'' PrinterMsg "Referenzzähler B SNr: " & m_ReferenzzaehlerB.SerienNr
|
|
'' PrinterMsg " Impulswertigkeit: " & m_ReferenzzaehlerB.ImpulseQM
|
|
'' PrinterMsg "Prüfpunkt: " & DurchflussSoll
|
|
'Exit Sub
|
|
'Errorhandler:
|
|
' Printer.KillDoc
|
|
' ErrorMsg "Fehler " & Err.Number & " in modDruck.RefZDruck() " & Err.Description
|
|
'End Sub
|
|
|
|
Public Sub PruefgangDruck(pruefgang As CPruefgang, Temperatur As Double, colEinbauplaetze As Collection, pZAnzahl As Integer, Optional sBemerkung As String = "")
|
|
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim PPNr As Byte
|
|
Dim Zeile As String
|
|
Dim strReferenmethode As String
|
|
Dim i As Integer
|
|
|
|
Call initPrint(g_App.Settings.PrintDir & CStr(pruefgang.PruefgangNr) & ".txt")
|
|
|
|
PrintString vbCrLf & vbCrLf
|
|
|
|
If pruefgang.PP_Waage(1) <> 0 Then
|
|
strReferenmethode = "gegen Waage "
|
|
Else
|
|
strReferenmethode = "gegen Referenzzähler "
|
|
End If
|
|
|
|
|
|
'Prüfprotokoll Prüfgang: @@@@@@@@@@ Datum: 22.06.2000 08:22
|
|
PrintString Space(RAND) & "Prüfprotokoll Prüfgang: " & _
|
|
Format(pruefgang.PruefgangNr, "@@@@@@@@@@") & _
|
|
" Datum: " & Format(pruefgang.Datum, "dd.mm.yyyy hh:mm")
|
|
|
|
'Prüfstation: 2000 Meinecke Linie 2
|
|
PrintString Space(RAND) & "Prüftstation: " & Format(g_App.PruefstationNr, "@@@@") & " " & _
|
|
g_App.Settings.PruefstationKunde & " " & _
|
|
g_App.Settings.PruefstationStandort
|
|
|
|
Zeile = ", geprüft wurden " & Format(pruefgang.Anzahl, "@") & " Zähler "
|
|
|
|
If pruefgang.Anzahl = 1 Then
|
|
Zeile = ", geprüft wurde " & Format(pruefgang.Anzahl, "@") & " Zähler "
|
|
End If
|
|
|
|
'Prüfer: A. Pfeiffer, Vorlauftemp.: 17,6 C°, 6 Zähler
|
|
PrintString Space(RAND) & "Prüfer: " & Left(g_App.Mitarbeiter.getVorname, 1) & ". " & g_App.Mitarbeiter.getName _
|
|
& ", Vorlauftemp.: " & Format(pruefgang.Vorlauftemperatur, "0.0") _
|
|
& " C°" & Zeile
|
|
|
|
Zeile = ""
|
|
If pruefgang.PruefgangLang = True Then
|
|
Zeile = Zeile & "mit der Prüfart Lang, "
|
|
End If
|
|
Zeile = Zeile & strReferenmethode
|
|
|
|
PrintString Space(RAND) & Zeile
|
|
|
|
|
|
For Each Einbauplatz In colEinbauplaetze
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
|
|
PrintString Space(RAND) & "----------------------------------------------------------------------"
|
|
|
|
PrintString Space(RAND) & Einbauplatz.getNr & ". Einbauplatz, Auftrag: " _
|
|
& Format(Pruefzaehler.getAuftrag.getNr, "@@@@@") _
|
|
& "/" & Format(Pruefzaehler.getAuftragPosition.getNr, "@@")
|
|
|
|
|
|
'Geändert am 14.09.02 Pfeiffer
|
|
If Pruefzaehler.getAuftragPositionSerienNr.getFabNr <> 0 Then
|
|
PrintString Space(RAND) & "Seriennummer: " & FormatSerienNr(Pruefzaehler.getSerienNr) _
|
|
& ", geprüft nach Klasse " & Pruefzaehler.getPruefklasseKZ _
|
|
& ", Gerätenummer: " & Pruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
Else
|
|
PrintString Space(RAND) & "Seriennummer: " & FormatSerienNr(Pruefzaehler.getSerienNr) _
|
|
& ", geprüft nach Klasse " & Pruefzaehler.getPruefklasseKZ
|
|
End If
|
|
|
|
If Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr <> "" Then
|
|
PrintString Space(RAND) & "Kundeneigene Seriennummer: " & Pruefzaehler.m_strKundeneigeneSerienNr
|
|
End If
|
|
|
|
Zeile = "Zählertyp: " & Pruefzaehler.getIdentNrObj.getTyp & ", DN" _
|
|
& Pruefzaehler.getIdentNrObj.getNennweite & " "
|
|
|
|
If Pruefzaehler.getIdentNrObj.getTypzusatz = "" Then
|
|
Zeile = Zeile & ", " _
|
|
& Pruefzaehler.getIdentNrObj.GetTemperatur & " Grad, Anzeige: " _
|
|
& Pruefzaehler.getAuftragPosition.getAnzeige
|
|
Else
|
|
Zeile = Zeile & Pruefzaehler.getIdentNrObj.getTypzusatz & ", " _
|
|
& Pruefzaehler.getIdentNrObj.GetTemperatur & " Grad, Anzeige: " _
|
|
& Pruefzaehler.getAuftragPosition.getAnzeige
|
|
End If
|
|
|
|
PrintString Space(RAND) & Zeile
|
|
|
|
PPNr = 0
|
|
|
|
PrintString Space(RAND) & ""
|
|
Zeile = ""
|
|
For Each Pruefpunkt In Pruefzaehler.getPruefpunkte.getPruefpunkte.getCollection
|
|
PPNr = PPNr + 1
|
|
|
|
Zeile = "Prüfpunkt " & Format(PPNr, "##") & ": [" & Format(pruefgang.PP_Zeit(CInt(PPNr)), "@@@@") & "s] "
|
|
|
|
Zeile = Zeile & Format(Pruefpunkt.getQ, "@@@@@@") & " m³/h "
|
|
|
|
If Pruefpunkt.GetFehler > 90 Or Einbauplatz.getAktiv = False Then
|
|
Zeile = Zeile & "**** Fehlerhafte Prf"
|
|
Else
|
|
If Pruefpunkt.GetFehler < 0 Then
|
|
Zeile = Zeile & Format(Pruefpunkt.GetFehler, "0.0")
|
|
Else
|
|
Zeile = Zeile & Format(Pruefpunkt.GetFehler, "+0.0")
|
|
End If
|
|
If GrenzwertUeberschritten(Pruefpunkt.getFGo, Pruefpunkt.GetFehler, Pruefpunkt.getFGu) Then
|
|
Zeile = Zeile & " FG überschritten !"
|
|
End If
|
|
End If
|
|
|
|
PrintString Space(RAND) & Zeile
|
|
Next ' Pruefpunkt
|
|
End If ' Pruefzaehler is not nothing
|
|
Next ' Einbauplatz
|
|
PrintString vbCrLf & vbCrLf
|
|
If Right(sBemerkung, 2) <> vbCrLf Then sBemerkung = sBemerkung & vbCrLf
|
|
For i = 0 To UBound(Split(sBemerkung, vbCrLf)) - 1
|
|
PrintString Space(RAND) & Replace(Split(sBemerkung, vbCrLf)(i), vbCrLf, "")
|
|
Next
|
|
|
|
' PrintString vbCrLf & vbCrLf & Space(RAND) & sBemerkung
|
|
PrintEnd
|
|
End Sub
|
|
|
|
Public Function RZFehlerRecordset(Pruefstation As Integer, EinbauplatzNr As Integer, Temperatur As Double, Optional AnzahlZeilen As Integer = 4) As CRecordset
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
Set rs = New CRecordset
|
|
|
|
sSQL = "SELECT Top " & AnzahlZeilen & " * FROM ReferenzzaehlerFehler "
|
|
sSQL = sSQL & "Inner Join Referenzzaehler ON ReferenzzaehlerFehler.SerienNr = Referenzzaehler.SerienNr "
|
|
sSQL = sSQL & "Where (Referenzzaehler.PruefstationNr = " & Pruefstation & ") "
|
|
|
|
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 & "and EinbauplatzNr = '" & EinbauplatzNr & "' "
|
|
sSQL = sSQL & "ORDER BY Nennweite, Datum DESC"
|
|
Debug.Print sSQL
|
|
|
|
rs.openRS sSQL, True
|
|
Set RZFehlerRecordset = rs
|
|
End Function
|
|
|
|
|
|
Public Sub RZFehlerDruck(Pruefstation As Integer, Temperatur As Double, Optional ByRef PrintObject As Object)
|
|
|
|
Dim Nennweite(4) As Integer
|
|
Dim rsA As CRecordset ' Strang A
|
|
Dim rsB As CRecordset ' Strang B
|
|
Dim rs As CRecordset ' aktiver Strang
|
|
Dim rs2 As CRecordset ' nicht aktiver Strang
|
|
|
|
|
|
Dim EinbauplatzNr As Integer
|
|
Dim Q(10) As Double
|
|
Dim i As Integer
|
|
Dim DurchflussSoll As Double
|
|
Dim PPNr As Integer
|
|
Dim MidGruppe As Integer
|
|
Dim AnzahlPP As Integer
|
|
Dim AnzahlPPinBlock As Integer
|
|
Dim Fehler As Double
|
|
Dim Durchflussgruppe As Integer
|
|
|
|
Dim strVerwendeteMIDGruppe As String
|
|
|
|
Dim sDruck As String
|
|
Dim sPuffer As String
|
|
Dim intSeite As Integer
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
If PrintObject Is Nothing Then
|
|
Set PrintObject = Printer
|
|
End If
|
|
|
|
If True Then
|
|
If TypeName(PrintObject) = "Printer" Then
|
|
' Querformat mit max 10 PP pro Prüfung
|
|
PrintObject.Orientation = cdlLandscape
|
|
PrintObject.Font = "Courier New"
|
|
PrintObject.FontSize = 10
|
|
ZEILEN_PRO_SEITE = 45
|
|
MAXPPPROSPALTE = 10
|
|
Else
|
|
' Querformat mit max 10 PP pro Prüfung
|
|
PrintObject.Font = "Courier New"
|
|
PrintObject.FontSize = 10
|
|
ZEILEN_PRO_SEITE = 300
|
|
MAXPPPROSPALTE = 10
|
|
End If
|
|
Else
|
|
' Hochformat mit max 5 PP pro Prüfung
|
|
On Error Resume Next
|
|
PrintObject.Orientation = cdlPortrait
|
|
On Error GoTo Errorhandler
|
|
ZEILEN_PRO_SEITE = 62
|
|
MAXPPPROSPALTE = 5
|
|
End If
|
|
|
|
'Drucke Seiten Ueberschrift
|
|
Call initPrint(g_App.Settings.PrintDir & Format(Now(), "RZ-yyyy-mm-dd--hhmm") & ".txt")
|
|
|
|
intSeite = 1
|
|
|
|
sDruck = ""
|
|
sDruck = sDruck & Space(RAND) & "--------------------------------------------------------------" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & " Referenzzähler-Fehler " & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & " (für die nächsten Hauptprüfungen zu verwenden) " & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "--------------------------------------------------------------" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "Ausdruck vom " & Format(Now, "dd.mm.yyyy hh.mm") & " durch Prüfer " & Mid(g_App.Mitarbeiter.getVorname, 1, 1) & ". " & g_App.Mitarbeiter.getName & " (" & g_App.Mitarbeiter.getNr & ")" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "für Prüfstation: " & Pruefstation & " "
|
|
|
|
If Temperatur < 40 Then
|
|
sDruck = sDruck & "Temperatur: Kalt < 40°C " & vbCrLf
|
|
ElseIf Temperatur < 70 Then
|
|
sDruck = sDruck & "Temperatur: Warm 40°C - 70°C " & vbCrLf
|
|
Else
|
|
sDruck = sDruck & "Temperatur: Heiss > 70°C " & vbCrLf
|
|
End If
|
|
|
|
MidGruppe = g_App.Settings.getMIDGruppe
|
|
If g_App.Settings.getAnzahlMIDGruppen = 1 Then
|
|
' es gibt nur eine MID Gruppe
|
|
MidGruppe = 1
|
|
End If
|
|
|
|
Select Case MidGruppe
|
|
Case 1
|
|
strVerwendeteMIDGruppe = "A"
|
|
Case 2
|
|
strVerwendeteMIDGruppe = "B"
|
|
End Select
|
|
|
|
If Pruefstation = g_App.PruefstationNr Then
|
|
sDruck = sDruck & Space(RAND) & "verwendete MID-Gruppe: " & strVerwendeteMIDGruppe
|
|
End If
|
|
|
|
sDruck = sDruck & Space(RAND) & vbCrLf & vbCrLf
|
|
|
|
' für alle Stränge
|
|
For EinbauplatzNr = 1 To 10 Step 2
|
|
|
|
Set rsA = RZFehlerRecordset(Pruefstation, EinbauplatzNr, Temperatur, 4)
|
|
Set rsB = RZFehlerRecordset(Pruefstation, EinbauplatzNr + 1, Temperatur, 4)
|
|
|
|
Select Case MidGruppe
|
|
Case 1
|
|
Set rs = rsA
|
|
Set rs2 = rsB
|
|
Case 2
|
|
Set rs = rsB
|
|
Set rs2 = rsA
|
|
End Select
|
|
|
|
Dim colPruefpunkt As CPruefpunktCol
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
Set colPruefpunkt = New CPruefpunktCol
|
|
|
|
' Die Prüfpunkte der letzten Prüfung und des aktiven Stranges sollten auf jeden Fall dabei sein
|
|
' allerdings nicht mehr als 5, die auf das Blatt passen.
|
|
|
|
Do While Not rs.EOF
|
|
For i = 1 To 10
|
|
DurchflussSoll = Round(rs.getDoubleValue("PP" & i & "_Soll_Q"), 4)
|
|
If DurchflussSoll > 0 And colPruefpunkt.Count < MAXPPPROSPALTE Then
|
|
If Not colPruefpunkt.hasQ(DurchflussSoll) Then
|
|
Debug.Print "Hinzu: Aktiver " & i & "=" & DurchflussSoll & " am " & rs.getDateValue("Datum")
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ DurchflussSoll
|
|
colPruefpunkt.Add Pruefpunkt
|
|
Else
|
|
Debug.Print "schon vorhanden Aktiver " & i & "=" & DurchflussSoll & " am " & rs.getDateValue("Datum")
|
|
End If
|
|
Else
|
|
Exit For
|
|
End If
|
|
Next
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
Do While Not rs2.EOF
|
|
For i = 1 To 10
|
|
DurchflussSoll = Round(rs2.getDoubleValue("PP" & i & "_Soll_Q"), 4)
|
|
If DurchflussSoll > 0 And colPruefpunkt.Count < MAXPPPROSPALTE Then
|
|
If Not colPruefpunkt.hasQ(DurchflussSoll) Then
|
|
Debug.Print "Hinzu: Nicht aktiver " & i & "=" & DurchflussSoll & " am " & rs2.getDateValue("Datum")
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ DurchflussSoll
|
|
colPruefpunkt.Add Pruefpunkt
|
|
Else
|
|
Debug.Print "schon vorhanden Nicht Aktiver" & i & "=" & DurchflussSoll & " am " & rs2.getDateValue("Datum")
|
|
End If
|
|
Else
|
|
Exit For
|
|
End If
|
|
Next
|
|
rs2.MoveNext
|
|
Loop
|
|
|
|
AnzahlPP = colPruefpunkt.Count
|
|
|
|
colPruefpunkt.sortQ
|
|
|
|
If rs.RecordCount > 0 Then
|
|
|
|
|
|
PrintAufSeite sPuffer, sDruck, ZEILEN_PRO_SEITE, PrintObject, intSeite, False
|
|
|
|
' Drucke Durchfluss Tabellen Header für die ersten 5 Durchfluesse
|
|
rs.MoveFirst
|
|
sDruck = sDruck & Space(RAND) & " Nennweite: " & rs.getIntValue("Nennweite") & " Durchfluss [m³/h]" & vbCrLf
|
|
|
|
'''''''''AAAAAAAAAAAAAAAAAAAA'''''''''''''''''''
|
|
|
|
sDruck = sDruck & Space(RAND) & "|MIDGrp| Datum |"
|
|
|
|
rs.MoveFirst
|
|
|
|
' Überschrift Durchflüsse
|
|
For i = 1 To colPruefpunkt.Count
|
|
DurchflussSoll = colPruefpunkt.Item(i).getQ
|
|
Debug.Print "Durchfluss " & i & " = " & DurchflussSoll
|
|
|
|
If DurchflussSoll = 0 Then
|
|
' keine weiteren Durchflüsse, Überschrift abrechen
|
|
Exit For
|
|
Else
|
|
' Durchflüsse für diesen Block
|
|
Q(i) = DurchflussSoll
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig(CStr(DurchflussSoll), 6) & " |"
|
|
AnzahlPPinBlock = i
|
|
End If
|
|
Next
|
|
|
|
|
|
sDruck = sDruck & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "|" & GetTrennerString(AnzahlPPinBlock) & "|" & vbCrLf
|
|
|
|
If rsA.RecordCount > 0 Then
|
|
' Falls A Datensätze vorhanden sind
|
|
' Drucke Gruppe A
|
|
rsA.MoveFirst
|
|
Do While Not rsA.EOF
|
|
sDruck = sDruck & Space(RAND) & "| " & rsA.getStringValue("MIDGruppe") & " |" & Format(rsA.getDateValue("Datum"), "dd.mm.yyyy hh:mm:ss") & "|"
|
|
For i = 1 To AnzahlPPinBlock
|
|
If SucheRZFehlerInRS(Q(i), rsA, Fehler) Then
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig(Round(Fehler, 2), 6) & " |"
|
|
Else
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig("", 6) & " |"
|
|
End If
|
|
Next
|
|
sDruck = sDruck & vbCrLf
|
|
rsA.MoveNext
|
|
Loop
|
|
End If
|
|
|
|
'''''''''BBBBBBBBBBBBBBBBBBBBBBB'''''''''''''''''''
|
|
If rsB.RecordCount > 0 Then
|
|
' Falls B Datensätze vorhanden sind
|
|
rsB.MoveFirst
|
|
If Not rsB.EOF Then
|
|
' Drucke Gruppe B
|
|
sDruck = sDruck & Space(RAND) & "|" & GetTrennerString(AnzahlPPinBlock) & "|" & vbCrLf
|
|
rsB.MoveFirst
|
|
Do While Not rsB.EOF
|
|
sDruck = sDruck & Space(RAND) & "| " & rsB.getStringValue("MIDGruppe") & " |" & Format(rsB.getDateValue("Datum"), "dd.mm.yyyy hh:mm:ss") & "|"
|
|
For i = 1 To AnzahlPPinBlock
|
|
If SucheRZFehlerInRS(Q(i), rsB, Fehler) Then
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig(Round(Fehler, 2), 6) & " |"
|
|
Else
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig("", 6) & " |"
|
|
End If
|
|
Next
|
|
sDruck = sDruck & vbCrLf
|
|
|
|
rsB.MoveNext
|
|
Loop
|
|
End If
|
|
End If ' Recordcount > 0
|
|
''''''''''''''''''''''''''''''''''''''''''''''
|
|
sDruck = sDruck & vbCrLf
|
|
|
|
PrintAufSeite sPuffer, sDruck, ZEILEN_PRO_SEITE, PrintObject, intSeite, False
|
|
Else
|
|
sDruck = sDruck & vbCrLf
|
|
End If ' rs.RecordCount > 0
|
|
Next ' Einbauplatz bzw. Nennweite
|
|
|
|
If Len(sPuffer) > 4 Then
|
|
sPuffer = Mid(sPuffer, 1, Len(sPuffer) - 4)
|
|
End If
|
|
|
|
' evtl. Rest an Puffer anhängen und ggF. neue Seite anfangen
|
|
PrintAufSeite sPuffer, sDruck, ZEILEN_PRO_SEITE, PrintObject, intSeite, False
|
|
|
|
g_strText = g_strText & sPuffer
|
|
|
|
PrintAufSeite sPuffer, "", ZEILEN_PRO_SEITE, PrintObject, intSeite, True
|
|
|
|
g_strText = g_strText & sPuffer
|
|
|
|
If Not PrintObject Is Nothing And TypeName(PrintObject) = "Printer" Then
|
|
On Error Resume Next
|
|
PrintObject.EndDoc
|
|
On Error GoTo Errorhandler
|
|
End If
|
|
Exit Sub
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " in Funktion RZFehlerDruck: " & Err.Description & vbCrLf & "Bitte Programmierer benachrichtigen."
|
|
Dim returnwert As Long
|
|
returnwert = MsgBox("Möchten Sie den Befehl, der den Fehler verursacht hat, wiederholen ?" & vbCrLf & "Nein=Weiter, Abbruch=RefZ.-Druck abbrechen", vbYesNoCancel, "Fehlerbehandlung")
|
|
If returnwert = vbYes Then
|
|
Resume
|
|
ElseIf returnwert = vbNo Then
|
|
Resume Next
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub PrintAufSeite(ByRef strPuffer As String, ByRef strBlock As String, MaxZeilen As Integer, objPrinter As Object, ByRef intSeite, blnLetzeSeite As Boolean)
|
|
Dim Anzahl As Integer
|
|
Dim i As Integer
|
|
|
|
Anzahl = AnzahlZeilenImString(strPuffer & strBlock)
|
|
|
|
If Anzahl >= MaxZeilen Then
|
|
' Block passt nicht mehr auf Seite
|
|
' Seite drucken
|
|
If Not objPrinter Is Nothing Then
|
|
objPrinter.Print strPuffer
|
|
End If
|
|
Debug.Print strPuffer
|
|
|
|
' Seiten-Nr drucken
|
|
If intSeite > 0 Then
|
|
If AnzahlZeilenImString(strPuffer) + 1 <= MaxZeilen Then
|
|
For i = AnzahlZeilenImString(strPuffer) + 1 To MaxZeilen
|
|
objPrinter.Print " "
|
|
Debug.Print "(Zeile " & i & " ist leer)"
|
|
Next
|
|
End If
|
|
Debug.Print Space(RAND) & " Seite " & intSeite
|
|
objPrinter.Print Space(RAND) & " Seite " & intSeite
|
|
End If
|
|
Debug.Print "==================================================="
|
|
|
|
' neue Seite anfangen falls nicht letze Seite
|
|
intSeite = intSeite + 1
|
|
If (Not objPrinter Is Nothing) And blnLetzeSeite = False Then
|
|
On Error Resume Next
|
|
objPrinter.NewPage
|
|
On Error GoTo 0
|
|
End If
|
|
' neuer Block in Puffer
|
|
strPuffer = vbCrLf & vbCrLf & strBlock
|
|
Else
|
|
' neuer Block an Puffer anhängen
|
|
strPuffer = strPuffer & strBlock
|
|
|
|
If blnLetzeSeite = True Then
|
|
If Not objPrinter Is Nothing Then
|
|
objPrinter.Print strPuffer
|
|
End If
|
|
Debug.Print strPuffer
|
|
|
|
' Seiten-Nr drucken
|
|
If intSeite > 0 Then
|
|
If AnzahlZeilenImString(strPuffer) + 1 <= MaxZeilen Then
|
|
For i = AnzahlZeilenImString(strPuffer) + 1 To MaxZeilen
|
|
objPrinter.Print ""
|
|
Debug.Print "(Zeile " & i & " ist leer)"
|
|
Next
|
|
End If
|
|
Debug.Print Space(RAND) & " Seite " & intSeite & " / " & intSeite
|
|
objPrinter.Print Space(RAND) & " Seite " & intSeite & " / " & intSeite
|
|
End If
|
|
Debug.Print "==================================================="
|
|
strPuffer = ""
|
|
End If
|
|
|
|
End If
|
|
strBlock = ""
|
|
End Sub
|
|
|
|
Public Function AnzahlZeilenImString(strIn As String)
|
|
Dim myArray() As String
|
|
myArray = Split(strIn, vbCrLf)
|
|
AnzahlZeilenImString = UBound(myArray) + 1
|
|
End Function
|
|
|
|
Public Sub RZFehlerDruck_alt(Pruefstation As Integer, Temperatur As Double)
|
|
Dim rsA As CRecordset
|
|
Dim rsB As CRecordset
|
|
|
|
Dim Q(10) As Double
|
|
Dim AnzahlPP As Integer
|
|
Dim DurchflussSoll As Double
|
|
Dim i As Integer
|
|
Dim EinbauplatzNr As Integer
|
|
Dim Fehler As Double
|
|
Dim strZeile As String
|
|
Dim strMIDGruppe As String
|
|
Dim strDatum As String
|
|
Dim sDruck As String
|
|
|
|
Dim DurchflussTeil As Integer
|
|
|
|
Dim strUeberschriftErsteZeile As String
|
|
Dim strUeberschriftZweiteZeile As String
|
|
|
|
Dim strVerwendeteMIDGruppe As String
|
|
|
|
strVerwendeteMIDGruppe = IIf(g_App.Settings.getMIDGruppe = 2, "B", "A")
|
|
|
|
|
|
Call initPrint(g_App.Settings.PrintDir & Format(Now(), "RZ-yyyy-mm-dd--hhmm") & ".txt")
|
|
|
|
sDruck = ""
|
|
sDruck = sDruck & Space(RAND) & "--------------------------------------------------------------" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & " Referenzzähler-Fehler " & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & " (für die nächsten Hauptprüfungen zu verwenden) " & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "--------------------------------------------------------------" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "Ausdruck vom " & Format(Now, "dd.mm.yyyy hh.mm") & " Prüfer: " & g_App.Mitarbeiter.getName & " (" & g_App.Mitarbeiter.getNr & ")" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "für Prüfstation: " & Pruefstation & " "
|
|
|
|
If Temperatur < 40 Then
|
|
sDruck = sDruck & "Temperatur: Kalt < 40°C " & vbCrLf
|
|
ElseIf Temperatur < 70 Then
|
|
sDruck = sDruck & "Temperatur: Warm 40°C - 70°C " & vbCrLf
|
|
Else
|
|
sDruck = sDruck & "Temperatur: Heiss > 70°C " & vbCrLf
|
|
End If
|
|
sDruck = sDruck & Space(RAND) & "verwendete MID-Gruppe: " & strVerwendeteMIDGruppe
|
|
sDruck = sDruck & Space(RAND) & vbCrLf
|
|
|
|
' für alle Stränge der MID Gruppe A
|
|
For EinbauplatzNr = 1 To 8 Step 2
|
|
Set rsA = RZFehlerRecordset(Pruefstation, EinbauplatzNr, Temperatur)
|
|
If Not rsA.EOF Then
|
|
|
|
For DurchflussTeil = 0 To 0 Step 5
|
|
|
|
Debug.Print "DurchflussTeil " & DurchflussTeil
|
|
rsA.MoveFirst
|
|
|
|
sDruck = sDruck & Space(RAND) & vbCrLf
|
|
|
|
sDruck = sDruck & Space(RAND) & " Nennweite: " & rsA.getIntValue("Nennweite") & " Durchfluss [m³/h]" & vbCrLf
|
|
sDruck = sDruck & Space(RAND) & "|MIDGrp| Datum |"
|
|
|
|
' alle Durchflüsse der letzen Prüfung bestimmen
|
|
|
|
' Anzahl der Prüfpunkte bestimmen
|
|
AnzahlPP = 5
|
|
|
|
' For i = 1 To 10
|
|
' DurchflussSoll = Round(rs.getDoubleValue("PP" & i + DurchflussTeil & "_Soll_Q"), 4)
|
|
' If DurchflussSoll = 0 Then
|
|
' Exit For
|
|
' Else
|
|
' AnzahlPP = i
|
|
' End If
|
|
' Next
|
|
|
|
For i = 1 + DurchflussTeil To 5 + DurchflussTeil
|
|
|
|
rsA.MoveFirst
|
|
DurchflussSoll = Round(rsA.getDoubleValue("PP" & i & "_Soll_Q"), 4)
|
|
If DurchflussSoll = 0 Then
|
|
Exit For
|
|
Else
|
|
Q(i) = DurchflussSoll
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig(CStr(DurchflussSoll), 6) & " |"
|
|
AnzahlPP = i
|
|
End If
|
|
'Debug.Print "Durchfluss: " & DurchflussSoll
|
|
Next i
|
|
sDruck = sDruck & vbCrLf
|
|
|
|
|
|
sDruck = sDruck & Space(RAND) & "|" & GetTrennerString(AnzahlPP) & "|" & vbCrLf
|
|
|
|
rsA.MoveFirst
|
|
Do While Not rsA.EOF
|
|
sDruck = sDruck & Space(RAND) & "| " & rsA.getStringValue("MIDGruppe") & " |" & Format(rsA.getDateValue("Datum"), "dd.mm.yyyy hh:mm:ss") & "|"
|
|
For i = 1 + DurchflussTeil To AnzahlPP + DurchflussTeil
|
|
If SucheRZFehlerInRS(Q(i), rsA, Fehler) Then
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig(Round(Fehler, 2), 6) & " |"
|
|
'Debug.Print Q(i) & "=" & Format(Fehler, "0.00")
|
|
Else
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig("", 6) & " |"
|
|
End If
|
|
Next
|
|
sDruck = sDruck & vbCrLf
|
|
rsA.MoveNext
|
|
Loop
|
|
|
|
' für alle Stränge der MID Gruppe B
|
|
|
|
Set rsB = RZFehlerRecordset(Pruefstation, EinbauplatzNr + 1, Temperatur)
|
|
|
|
If Not rsB.EOF Then
|
|
sDruck = sDruck & Space(RAND) & "|" & GetTrennerString(AnzahlPP) & "|" & vbCrLf
|
|
rsB.MoveFirst
|
|
Do While Not rsB.EOF
|
|
sDruck = sDruck & Space(RAND) & "| " & rsB.getStringValue("MIDGruppe") & " |" & Format(rsB.getDateValue("Datum"), "dd.mm.yyyy hh:mm:ss") & "|"
|
|
For i = 1 + DurchflussTeil To AnzahlPP + DurchflussTeil
|
|
If SucheRZFehlerInRS(Q(i), rsB, Fehler) Then
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig(Round(Fehler, 2), 6) & " |"
|
|
Else
|
|
sDruck = sDruck & FormatiereFeldRechtsbuendig("", 6) & " |"
|
|
End If
|
|
Next
|
|
sDruck = sDruck & vbCrLf
|
|
rsB.MoveNext
|
|
Loop
|
|
End If
|
|
|
|
sDruck = sDruck & vbCrLf
|
|
Next ' Durchflussteil =0 , =5
|
|
|
|
End If ' rsA.eof
|
|
Next EinbauplatzNr
|
|
|
|
Debug.Print sDruck
|
|
Printer.Print sDruck
|
|
Printer.EndDoc
|
|
|
|
End Sub
|
|
|
|
Private Function SucheRZFehlerInRS(Q As Double, rs As CRecordset, ByRef Fehler As Double) As Boolean
|
|
Dim i As Integer
|
|
For i = 1 To 10
|
|
If Round(Q, 4) = Round(rs.getDoubleValue("PP" & i & "_Soll_Q"), 4) Then
|
|
SucheRZFehlerInRS = True
|
|
Fehler = rs.getDoubleValue("PP" & i & "_Fehler")
|
|
Exit Function
|
|
End If
|
|
Next
|
|
SucheRZFehlerInRS = False
|
|
End Function
|
|
|
|
|
|
Private Function FormatiereFeldRechtsbuendig(strText, AnzahlStellen As Integer) As String
|
|
If AnzahlStellen > Len(strText) Then
|
|
' von links mit Space auffüllen
|
|
FormatiereFeldRechtsbuendig = Space(AnzahlStellen - Len(strText))
|
|
End If
|
|
FormatiereFeldRechtsbuendig = FormatiereFeldRechtsbuendig & Mid(strText, 1, AnzahlStellen)
|
|
End Function
|
|
|
|
Private Function GetTrennerString(AnzahlPP As Integer) As String
|
|
Dim i As Integer
|
|
GetTrennerString = "------+-------------------+"
|
|
For i = 1 To AnzahlPP
|
|
GetTrennerString = GetTrennerString & "-------"
|
|
If i < AnzahlPP Then
|
|
GetTrennerString = GetTrennerString & "+"
|
|
End If
|
|
Next
|
|
End Function
|