diff --git a/Shared/frmRuecklaeuferanalyse.frm b/Shared/frmRuecklaeuferanalyse.frm index c02ffee2..47a0ea98 100644 --- a/Shared/frmRuecklaeuferanalyse.frm +++ b/Shared/frmRuecklaeuferanalyse.frm @@ -1,1279 +1,5 @@ -VERSION 5.00 -Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX" -Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx" -Begin VB.Form frmRuecklaeuferanalyse - BorderStyle = 1 'Fest Einfach - Caption = "Rückläuferanaylse QA_M_037" - ClientHeight = 10230 - ClientLeft = 1155 - ClientTop = 3915 - ClientWidth = 12990 - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 10230 - ScaleWidth = 12990 - Begin VB.Frame Frame1 - Height = 3075 - Left = 60 - TabIndex = 24 - Top = 1320 - Width = 4395 - Begin VB.Label Label8 - Alignment = 1 'Rechts - Caption = "Geräte-Nr.:" - Height = 195 - Left = 90 - TabIndex = 47 - Top = 2670 - Width = 915 - End - Begin VB.Label lblFabNr - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 46 - Top = 2640 - Width = 1395 - End - Begin VB.Label lblDatum - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 44 - Top = 600 - Width = 2355 - End - Begin VB.Label Label7 - Alignment = 1 'Rechts - Caption = "Datum:" - Height = 195 - Left = 300 - TabIndex = 43 - Top = 600 - Width = 615 - End - Begin VB.Label Label4 - Alignment = 1 'Rechts - Caption = "Prüfgang Datum" - Height = 195 - Left = 60 - TabIndex = 40 - Top = 1500 - Width = 1215 - End - Begin VB.Label lblPruefgangDatum - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 39 - Top = 1500 - Width = 2775 - End - Begin VB.Label Label21 - Caption = "Prüfer:" - Height = 255 - Left = 420 - TabIndex = 37 - Top = 240 - Width = 615 - End - Begin VB.Label lblPruefer - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 36 - Top = 240 - Width = 2355 - End - Begin VB.Label lblStatus - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 34 - Top = 2280 - Width = 2775 - End - Begin VB.Label Label24 - Caption = "Status:" - Height = 255 - Left = 420 - TabIndex = 33 - Top = 2280 - Width = 495 - End - Begin VB.Label lblPruefgang - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 32 - Top = 1140 - Width = 1395 - End - Begin VB.Label Label19 - Caption = "Prüfgang:" - Height = 195 - Left = 420 - TabIndex = 31 - Top = 1140 - Width = 735 - End - Begin VB.Label Label12 - Caption = "Wdh." - Height = 255 - Left = 3060 - TabIndex = 30 - Top = 1200 - Width = 435 - End - Begin VB.Label lblWiederholung - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 3600 - TabIndex = 29 - Top = 1140 - Width = 555 - End - Begin VB.Label lblPruefstation - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1380 - TabIndex = 28 - Top = 1860 - Width = 795 - End - Begin VB.Label Label9 - Caption = "Prüfstation:" - Height = 195 - Left = 420 - TabIndex = 27 - Top = 1860 - Width = 855 - End - Begin VB.Label Label10 - Caption = "Einbauplatz: " - Height = 255 - Left = 2640 - TabIndex = 26 - Top = 1920 - Width = 915 - End - Begin VB.Label lblEinbauplatz - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 3600 - TabIndex = 25 - Top = 1860 - Width = 555 - End - End - Begin MSComctlLib.StatusBar StatusBar1 - Align = 2 'Unten ausrichten - Height = 375 - Left = 0 - TabIndex = 23 - Top = 9855 - Width = 12990 - _ExtentX = 22913 - _ExtentY = 661 - Style = 1 - _Version = 393216 - BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} - NumPanels = 1 - BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} - EndProperty - EndProperty - End - Begin VB.Frame fameHistorie - Caption = "Rückläufer Historie" - Height = 4620 - Left = 60 - TabIndex = 21 - Top = 4410 - Width = 4395 - Begin VB.ListBox lstHistorie - Height = 1815 - Left = 150 - TabIndex = 22 - Top = 270 - Width = 4035 - End - Begin VB.CommandButton cmdPrint - Caption = "Drucken" - Height = 375 - Left = 210 - TabIndex = 45 - Top = 2520 - Width = 1275 - End - Begin VB.Label lblGesZeit - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 3390 - TabIndex = 42 - Top = 2580 - Width = 675 - End - Begin VB.Label Label1 - Caption = "Ges. Zeitaufwand" - Height = 255 - Left = 2010 - TabIndex = 41 - Top = 2640 - Width = 1515 - End - End - Begin VB.Frame frameOK - Height = 825 - Left = -15 - TabIndex = 19 - Top = 9030 - Width = 12960 - Begin VB.CommandButton cmdBeenden - Caption = "Schließen" - Height = 375 - Left = 10830 - TabIndex = 20 - Top = 315 - Width = 1965 - End - End - Begin VB.Frame fmAusfall - Caption = "Ausfall " - Height = 7680 - Left = 4515 - TabIndex = 9 - Top = 1320 - Width = 8430 - Begin VB.ComboBox cmbBefund - Height = 315 - Left = 2295 - Style = 2 'Dropdown-Liste - TabIndex = 51 - Top = 6480 - Width = 4245 - End - Begin VB.ListBox lstAusfallgrund - Height = 1410 - Left = 240 - Style = 1 'Kontrollkästchen - TabIndex = 48 - Top = 1680 - Width = 7995 - End - Begin VB.CommandButton cmdSave - Caption = "Speichern" - BeginProperty Font - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 700 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 525 - Left = 6180 - TabIndex = 38 - Top = 7005 - Width = 2100 - End - Begin VB.TextBox txtZeitaufwand - Alignment = 1 'Rechts - Height = 315 - Left = 1290 - TabIndex = 18 - Top = 6975 - Width = 555 - End - Begin VB.TextBox txtReparaturmassnahme - Height = 1125 - Left = 180 - MultiLine = -1 'True - ScrollBars = 2 'Vertikal - TabIndex = 16 - Top = 5265 - Width = 8025 - End - Begin VB.TextBox txtAusfallgrund - Height = 1395 - Left = 255 - MultiLine = -1 'True - ScrollBars = 2 'Vertikal - TabIndex = 13 - Top = 3570 - Width = 8025 - End - Begin MSFlexGridLib.MSFlexGrid msfgPruefpunkte - Height = 915 - Left = 240 - TabIndex = 10 - Top = 450 - Width = 8085 - _ExtentX = 14261 - _ExtentY = 1614 - _Version = 393216 - End - Begin VB.Label Label13 - Caption = "Maßnahme erfolgreich:" - Height = 255 - Left = 375 - TabIndex = 52 - Top = 6525 - Width = 2070 - End - Begin VB.Label Label20 - Caption = "min" - Height = 255 - Left = 1950 - TabIndex = 35 - Top = 7005 - Width = 375 - End - Begin VB.Label Label17 - Caption = "Zeitaufwand" - Height = 255 - Left = 210 - TabIndex = 17 - Top = 7035 - Width = 1455 - End - Begin VB.Label Label16 - Caption = "Reparatur-Massnahmen" - Height = 285 - Left = 195 - TabIndex = 15 - Top = 5055 - Width = 4695 - End - Begin VB.Label Label15 - Caption = "sonstige Ausfallgründe" - Height = 195 - Left = 255 - TabIndex = 14 - Top = 3270 - Width = 4035 - End - Begin VB.Label Label14 - Caption = "Ergebnis der letzten Prüfung" - Height = 255 - Left = 240 - TabIndex = 12 - Top = 210 - Width = 2115 - End - Begin VB.Label lblAusfallgrund - Caption = "Ausfallgründe" - Height = 195 - Left = 240 - TabIndex = 11 - Top = 1380 - Width = 2175 - End - End - Begin VB.Frame frameAuftragsdaten - Caption = "Auftragsdaten" - Height = 1275 - Left = 60 - TabIndex = 0 - Top = 0 - Width = 12885 - Begin VB.Label lblKundeneigeneSNr - Alignment = 1 'Rechts - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 5100 - TabIndex = 50 - Top = 810 - Width = 2355 - End - Begin VB.Label Label11 - Caption = "Kundeneigene SNr.:" - Height = 255 - Left = 3300 - TabIndex = 49 - Top = 840 - Width = 1605 - End - Begin VB.Label lblBezeichnung - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 4440 - TabIndex = 8 - Top = 360 - Width = 3015 - End - Begin VB.Label Label6 - Alignment = 1 'Rechts - Caption = "Bezeichnung:" - Height = 195 - Left = 3240 - TabIndex = 7 - Top = 360 - Width = 1035 - End - Begin VB.Label lblSerienNr - Alignment = 2 'Zentriert - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1590 - TabIndex = 6 - Top = 780 - Width = 1395 - End - Begin VB.Label Label5 - Caption = "SerienNr.:" - Height = 255 - Left = 720 - TabIndex = 5 - Top = 780 - Width = 795 - End - Begin VB.Label lblKunde - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 8430 - TabIndex = 4 - Top = 390 - Width = 3015 - End - Begin VB.Label Label3 - Caption = "Kunde:" - Height = 195 - Left = 7710 - TabIndex = 3 - Top = 390 - Width = 555 - End - Begin VB.Label Label2 - Caption = "Auftrag / Position:" - Height = 255 - Left = 180 - TabIndex = 2 - Top = 360 - Width = 1275 - End - Begin VB.Label lblAuftragPosNr - Alignment = 2 'Zentriert - BorderStyle = 1 'Fest Einfach - Height = 255 - Left = 1560 - TabIndex = 1 - Top = 360 - Width = 1395 - End - End - Begin VB.Image ImgLogo - Height = 2250 - Left = 705 - Picture = "frmRuecklaeuferanalyse.frx":0000 - Stretch = -1 'True - Top = 6225 - Visible = 0 'False - Width = 8100 - End -End -Attribute VB_Name = "frmRuecklaeuferanalyse" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Public m_Pruefgang As CPruefgang -Public m_Pruefzaehler As CPruefzaehler -Public m_EinbauplatzNr As Integer - -' Daten zu Beginn -Dim m_objAuftrag As CAuftrag -Dim m_objAuftragPosition As CAuftragPosition -Dim m_objIdentNr As CIdentNr -Dim m_objAuftragPositionSerienNr As CAuftragPositionSerienNr - -Dim m_intWiederholungen As Integer -Dim m_strStatus As String -Dim mcol_IDs As Collection - - -Const NEU = "(neu)" -Const TXT_BITTEAUSWAEHLEN = "(Bitte auswählen!)" -Const TXT_ERFOLGREICH = "Zähler erfolgreich geprüft" -Const TXT_ERNEUTAUSGEFALLEN = "Zähler erneut ausgefallen" - -Private m_lngID As Long - -Private mdblLinkerRand As Double -Private mdblRechterRand As Double -Private mdblObererRand As Double -Private mdblUntererRand As Double -Private mdblLinie1top As Double -Private mdblCurrentY As Double -Private mblnIstNeuerEintrag As Boolean - - -Private Sub cmbBefund_Click() - Datengeaendert -End Sub - -Private Sub cmdBeenden_Click() - Dim lngReturn As Long - - If cmdSave.Enabled = True Then - lngReturn = MsgBox("Sollen Ihre Änderungen gespeichert werden?", vbYesNoCancel Or vbDefaultButton1 Or vbExclamation, Me.caption) - Select Case lngReturn - Case vbYes - If speichern() = True Then - Unload Me - End If - Case vbNo - Unload Me - Case vbCancel - End Select - Else - Unload Me - End If -End Sub - - -Private Sub cmdSave_Click() - cmdSave.Enabled = False - If speichern() Then - FilllstHistorie - End If - cmdSave.Enabled = False -End Sub - -Private Sub Datengeaendert() - cmdSave.Enabled = True -End Sub - -'Private Sub Command1_Click() -' Dim rs As CRecordset -' Set rs = New CRecordset -' -' Dim rs1 As CRecordset -' Set rs1 = New CRecordset -' -' Dim rs2 As CRecordset -' Set rs2 = New CRecordset -' -' rs.openRS "Ruecklaeuferanalyse", True -' -' Do While Not rs.EOF -' rs1.openRS "select * from Ausfallgruende_bak where Text = '" & rs.getStringValue("Ausfallgrund") & "'" -' -' If Not rs1.EOF Then -' Set rs2 = New CRecordset -' rs2.openRS "Ruecklaeufer_Ausfallgrund" -' rs2.addNew -' Call rs2.setValue("Ruecklaufer_ID", rs.getIntValue("ID")) -' Call rs2.setValue("Ausfallgrund_ID", rs1.getIntValue("ID")) -' rs2.update -' End If -' -' rs.MoveNext -' Loop -'End Sub - -Private Sub Form_Activate() - If m_Pruefzaehler Is Nothing Then - Unload Me - End If -End Sub - -Private Sub Form_Load() - On Error GoTo Errorhandler - Dim strSearch As String - - Dim lngSerienNr As Long - - If m_Pruefzaehler Is Nothing Then - Set m_Pruefzaehler = New CPruefzaehler - - strSearch = InputBox("Bitte geben Sie die SerienNr, kundeneigene SNr oder Gerätenummer des Zählers an", "Rückläufer Analyse") - lngSerienNr = val(strSearch) - - If strSearch <> "" Then - Screen.MousePointer = vbHourglass - If m_Pruefzaehler.loadForSerienOrFabNummerOrKundeneigene(strSearch) = False Then - Call MsgBox("Prüfzählerdaten konnten für Nr. " & lngSerienNr & " nicht geladen werden", vbCritical, "Rückläufer Analyse") - Set m_Pruefzaehler = Nothing - Screen.MousePointer = vbNormal - Exit Sub - End If - Screen.MousePointer = vbNormal - Else - Set m_Pruefzaehler = Nothing - Exit Sub - End If - End If - - - Set m_objAuftrag = m_Pruefzaehler.getAuftrag - Set m_objAuftragPosition = m_Pruefzaehler.getAuftragPosition - Set m_objIdentNr = m_objAuftragPosition.getIdentNrObj - - Set m_objAuftragPositionSerienNr = New CAuftragPositionSerienNr - m_objAuftragPositionSerienNr.load (m_Pruefzaehler.getSerienNr) - 'If m_objAuftragPositionSerienNr.getPruefgangNr <> 0 Then - - 'm_Pruefgang.PruefgangNr = m_objAuftragPositionSerienNr.getPruefgangNr - 'm_Pruefgang.load (m_Pruefgang.PruefgangNr) - - 'End If - ' Auftragsdaten - lblAuftragPosNr.caption = m_objAuftrag.getNr & " / " & m_objAuftragPosition.getNr - lblSerienNr.caption = FormatSerienNr(m_Pruefzaehler.getSerienNr) - lblKunde.caption = m_objAuftrag.getKunde.getName & ", " & m_objAuftrag.getKunde.getOrt - lblBezeichnung.caption = m_objIdentNr.getTyp & " " & m_objIdentNr.getTypzusatz & " DN" & m_objIdentNr.getNennweite & " " & m_objIdentNr.GetTemperatur & "ßC/PN " & m_objIdentNr.getDruck & " (" & m_objAuftragPosition.getAnzeige & ")" - lblFabNr.caption = m_Pruefzaehler.getAuftragPositionSerienNr.getFabNr - lblKundeneigeneSNr.caption = m_Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr - - Call Fill_lstAusfallgrund - Call FilllstHistorie - - Call fillPruefgangFelder - Call clearPruefpunkteFlexgrid - - If Not m_Pruefgang Is Nothing Then - Call fillPrueffehler - End If - - cmbBefund.Clear - cmbBefund.AddItem TXT_BITTEAUSWAEHLEN - cmbBefund.ListIndex = 0 - cmbBefund.AddItem TXT_ERFOLGREICH - cmbBefund.AddItem TXT_ERNEUTAUSGEFALLEN - cmdSave.Enabled = False -Exit Sub -Errorhandler: - MsgBox "Fehler " & Err.Number & " in Rückläuferanalye (Form_Load):" & Err.Description -End Sub - -Private Sub clearPruefpunkteFlexgrid() - msfgPruefpunkte.Clear - msfgPruefpunkte.Font.Size = 10 - msfgPruefpunkte.Font.Bold = True - msfgPruefpunkte.col = 0 - msfgPruefpunkte.row = 0 - msfgPruefpunkte.text = "Q [m³/h]" - msfgPruefpunkte.row = 1 - msfgPruefpunkte.text = "Fehler [%]" - -End Sub - -Private Sub fillPrueffehler() - Dim i As Integer - Dim rs As CRecordset - Dim strTemp As String - Dim Fehler As Double - Dim Durchfluss As Double - - Set rs = New CRecordset - rs.openRS "SELECT * FROM Prueffehler where SerienNr=" & m_Pruefzaehler.getSerienNr & " and PruefgangNr= " & m_Pruefgang.PruefgangNr - If Not rs.EOF Then - For i = 1 To 10 - strTemp = "PP" & i & "_Fehler" - If rs.isFieldNull(strTemp) Then Exit For - msfgPruefpunkte.cols = i + 1 - - ' Fehler vorhanden - Fehler = Round(rs.getDoubleValue(strTemp), 2) - Durchfluss = Round(m_Pruefgang.PP_Soll(i), 5) - msfgPruefpunkte.col = i - msfgPruefpunkte.row = 0 - - Durchfluss = Round(Durchfluss, 5) - msfgPruefpunkte.text = CStr(Durchfluss) - msfgPruefpunkte.row = 1 - msfgPruefpunkte.text = Format(Fehler, "0.0") - Next - End If -End Sub - -Private Sub fillPruefgangFelder() - Dim Wiederholungen As Long - - ' Pruefgangdaten - lblPruefer.caption = g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName - - If Not m_Pruefgang Is Nothing Then - If m_Pruefgang.PruefgangNr <> 0 Then - lblPruefgang.caption = m_Pruefgang.PruefgangNr - lblPruefgangDatum.caption = m_Pruefgang.Datum - Else - lblPruefgang.caption = "" - lblPruefgangDatum.caption = "" - End If - Else - lblPruefgang.caption = "" - lblPruefgangDatum.caption = "" - End If - lblPruefstation.caption = g_App.PruefstationNr - lblEinbauplatz.caption = m_EinbauplatzNr - - lblDatum.caption = Now - ' Auftragsposition - Wiederholungen = m_objAuftragPositionSerienNr.getWiederholungen - - lblWiederholung.caption = Wiederholungen - - m_strStatus = getStatusFertigung(m_objAuftragPositionSerienNr.getStatusFertigung) & " (" & m_objAuftragPositionSerienNr.getStatusFertigung & ")" - lblStatus.caption = m_strStatus -End Sub - -Private Sub Fill_lstAusfallgrund() - lstAusfallgrund.Clear - Dim rs As CRecordset - Set rs = New CRecordset - - rs.openRS "SELECT * from Ausfallgruende where ZurAuswahl = 1 order by Sortorder", True - Do While Not rs.EOF - lstAusfallgrund.AddItem rs.getStringValue("ID") & ": " & rs.getStringValue("Text") - rs.MoveNext - Loop - -End Sub - -Private Sub Select_lstAusfallgrund(RuecklaeuferID As Long) - Dim rs As CRecordset - Dim i As Integer - Dim blnGefunden As Boolean - Dim rs1 As CRecordset - - Set rs = New CRecordset - rs.openRS "SELECT Ausfallgrund_ID FROM Ruecklaeufer_Ausfallgrund where Ruecklaufer_ID=" & RuecklaeuferID, True - Do While Not rs.EOF - blnGefunden = False - For i = 0 To lstAusfallgrund.ListCount - 1 - If val(lstAusfallgrund.List(i)) = rs.getLongValue("Ausfallgrund_ID") Then - lstAusfallgrund.Selected(i) = True - blnGefunden = True - End If - Next - If blnGefunden = False Then - Set rs1 = New CRecordset - rs1.openRS "SELECT * from Ausfallgruende where ID=" & rs.getLongValue("Ausfallgrund_ID") - If Not rs1.EOF Then - lstAusfallgrund.AddItem rs1.getStringValue("ID") & ": " & rs1.getStringValue("Text") & " (Veraltet)" - Else - lstAusfallgrund.AddItem "???" - End If - - lstAusfallgrund.Selected(lstAusfallgrund.ListCount - 1) = True - Set rs1 = Nothing - End If - rs.MoveNext - Loop -End Sub - -Public Function getStatusFertigung(intStatus As Integer) As String - Select Case intStatus - '0=ohne Bearbeitung, 10=Vorfertigung OK, 20=Montage,22=Prßfung abgebrochen, - '25=Grenzwertßberschreitung Prßfstation, 30=Prßfstation geprßft, 40=dieser Zßhler ausgeliefert,45= Lagerauftrag an Lager geliefert, 50=Auftrag ausgeliefert - Case 0 - getStatusFertigung = "ohne Bearbeitung" - Case 10 - getStatusFertigung = "Vorfertigung" - Case 20 - getStatusFertigung = "Montage" - Case 22 - getStatusFertigung = "Prüfung abgebrochen" - Case 25 - getStatusFertigung = "Grenzwertüberschreitung" - Case 30 - getStatusFertigung = "Prüfstation geprüft" - Case 40 - getStatusFertigung = "Zähler ausgeliefert" - Case 45 - getStatusFertigung = "Lagerauftrag an Lager geliefert" - Case 50 - getStatusFertigung = "Auftrag ausgeliefert" - End Select - -End Function - - -Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) - Dim lngReturn As Long - If UnloadMode = 0 And cmdSave.Enabled = True Then - ' Benutzer hat auf [X] rechts oben geklickt - lngReturn = MsgBox("Sollen Ihre Änderungen gespeichert werden?", vbYesNoCancel Or vbDefaultButton1 Or vbExclamation, Me.caption) - Select Case lngReturn - Case vbCancel - Cancel = 1 - Case vbYes - Call speichern - Cancel = 0 - Case vbNo - Cancel = 0 - End Select - End If -End Sub - -Private Function speichern() As Boolean - On Error GoTo Errorhandler - - Dim rs As CRecordset - Dim blnAktualisieren As Boolean - - Set rs = New CRecordset - ' Pflichtfelder - If PruefeAufPflichtfelder() = False Then - speichern = False - Exit Function - End If - - - If m_lngID = 0 Then - ' als Neu abspeichern - rs.openRS "Ruecklaeuferanalyse", False - rs.addNew - - ' Felder fßr die Neuanlage - - Call rs.setValue("AuftragNr", m_Pruefzaehler.getAuftrag.getNr) - Call rs.setValue("PositionNr", m_Pruefzaehler.getAuftragPosition.getNr) - Call rs.setValue("SerienNr", m_Pruefzaehler.getSerienNr) - Call rs.setValue("Kunde", lblKunde.caption) - - If Not m_Pruefgang Is Nothing Then - If m_Pruefgang.PruefgangNr > 0 Then - Call rs.setValue("PruefgangNr", m_Pruefgang.PruefgangNr) - Call rs.setValue("PruefgangDatum", m_Pruefgang.Datum) - End If - End If - - Call rs.setValue("AnlageDatum", Now()) - lblDatum.caption = Now() - - Call rs.setValue("Wiederholung", m_objAuftragPositionSerienNr.getWiederholungen) - - Call rs.setValue("Pruefstation", g_App.PruefstationNr) - Call rs.setValue("Einbauplatz", m_EinbauplatzNr) - Call rs.setValue("Pruefer", g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName) - Call rs.setValue("PrueferNr", g_App.Mitarbeiter.getNr) - Call rs.setValue("StatusFertigung", m_strStatus) - - - - Call rs.setValue("Bezeichnung", lblBezeichnung.caption) - - ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - '''' Prßfpunkte speichern - ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - Dim strQ As String - Dim strFehler As String - Dim strTrenner As String - Dim i As Integer - - strTrenner = "" - strQ = "" - strFehler = "" - - For i = 1 To msfgPruefpunkte.cols - 1 - msfgPruefpunkte.col = i - msfgPruefpunkte.row = 0 - strQ = strQ & strTrenner & msfgPruefpunkte.text - msfgPruefpunkte.row = 1 - strFehler = strFehler & strTrenner & msfgPruefpunkte.text - strTrenner = "|" - Next - - rs.setValue "Pruefpunkte", strQ - rs.setValue "Fehler", strFehler - - If lblFabNr.caption <> "" Then - Call rs.setValue("FabNr", lblFabNr.caption) - End If - Else - ' aktualisieren - - rs.openRS "SELECT * from Ruecklaeuferanalyse where ID = " & m_lngID, False - If rs.EOF Then - MsgBox "ID " & m_lngID & " existiert nicht. Datensatz kann nicht gespeichert werden." - speichern = False - Exit Function - End If - blnAktualisieren = True - End If - - ' hier gibt es diesen Datensatz und kann ggF. gendert werden - - Call rs.setValue("Zeitaufwand", val(txtZeitaufwand.text)) - - If Len(txtAusfallgrund.text) > 0 Then - Call rs.setValue("sonstigerAusfallgrund", txtAusfallgrund.text) - End If - - If txtReparaturmassnahme.text <> "" Then - Call rs.setValue("Befund", txtReparaturmassnahme.text) - End If - If cmbBefund.text = TXT_BITTEAUSWAEHLEN Then - ' nichts ausgewßhlt - ElseIf cmbBefund.text = TXT_ERFOLGREICH Then - rs.setValue "ReparaturErfolgreich", True - ElseIf cmbBefund.text = TXT_ERNEUTAUSGEFALLEN Then - rs.setValue "ReparaturErfolgreich", False - End If - - rs.update - If m_lngID = 0 Then - ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ' Die ID des eben gespeicherten Rßcklßufers - Set rs = New CRecordset - rs.openRS "SELECT newID = @@IDENTITY", True - m_lngID = rs.getIntValue("newID") - End If - - Call SaveAusfallgruende(m_lngID) - - TestAufAusfallgrund - - FilllstHistorie - speichern = True - Exit Function -Errorhandler: - ErrorMsg "Fehler " & Err.Number & " beim Speichern des Rückläufers: " & Err.Description -End Function - -Private Sub lstAusfallgrund_Click() - Call Datengeaendert -End Sub - -Private Sub lstHistorie_Click() - AktualisiereVonHistorie lstHistorie.ListIndex -End Sub - - -Private Function GetIDFromHistorie() As Long - Dim strTmp As String - strTmp = lstHistorie.List(lstHistorie.ListIndex) - If strTmp = NEU Then - GetIDFromHistorie = 0 - Else - GetIDFromHistorie = val(Split(strTmp, ")")(0)) - End If -End Function - -Private Sub AktualisiereVonHistorie(lngIndex As Long) - Dim strTmp As String - Dim lngID As Long - Dim i As Integer - Dim strDurchfluesse As String - Dim strFehler As String - Dim varPP As Variant - Dim rs As CRecordset - Dim strSQL As String - - On Error GoTo Errorhandler - - lngID = GetIDFromHistorie() - m_lngID = lngID - - - Call clearPruefpunkteFlexgrid - mblnIstNeuerEintrag = False - - If lngID = 0 Then ' Neu - cmdSave.Enabled = True - mblnIstNeuerEintrag = True - txtAusfallgrund.text = "" - txtReparaturmassnahme.text = "" - txtZeitaufwand = "" - - Fill_lstAusfallgrund - ' RH 31.07.2007: nichts auswßhlen - 'lstAusfallgrund.Selected(0) = True ' erster Eintrag ist selektiert - - FelderEingabenZulassen - Call fillPruefgangFelder - msfgPruefpunkte.cols = 1 - If Not m_Pruefgang Is Nothing Then - Call fillPrueffehler - End If - Exit Sub - End If - - - FelderSperren - - strSQL = "SELECT * from Ruecklaeuferanalyse where ID=" & lngID - Set rs = New CRecordset - rs.openRS strSQL, True - - If Not rs.EOF Then - - lblDatum.caption = rs.getDateValue("AnlageDatum") - - If val(rs.getLongValue("PruefgangNr")) > 0 Then - lblPruefgang.caption = rs.getLongValue("PruefgangNr") - Else - lblPruefgang.caption = "" - End If - - If Not rs.isFieldNull("PruefgangDatum") Then - lblPruefgangDatum.caption = rs.getDateValue("PruefgangDatum") - Else - lblPruefgangDatum.caption = "" - End If - - lblWiederholung.caption = rs.getIntValue("Wiederholung") - lblPruefstation.caption = rs.getIntValue("Pruefstation") - lblEinbauplatz.caption = rs.getIntValue("Einbauplatz") - lblPruefer.caption = rs.getStringValue("Pruefer") - lblStatus.caption = rs.getStringValue("StatusFertigung") - lblBezeichnung = rs.getStringValue("Bezeichnung") - - txtAusfallgrund.text = rs.getStringValue("sonstigerAusfallgrund") - txtReparaturmassnahme.text = rs.getStringValue("Befund") - - cmbBefund.text = TXT_BITTEAUSWAEHLEN - If Not rs.isFieldNull("ReparaturErfolgreich") Then - If rs.getBooleanValue("ReparaturErfolgreich") Then - cmbBefund.text = TXT_ERFOLGREICH - Else - cmbBefund.text = TXT_ERNEUTAUSGEFALLEN - End If - End If - - lblFabNr.caption = rs.getStringValue("FabNr") - - Dim rsAusfallgruende As CRecordset - Set rsAusfallgruende = New CRecordset - - lstAusfallgrund.Clear - Fill_lstAusfallgrund - Select_lstAusfallgrund (lngID) - - txtZeitaufwand = rs.getIntValue("Zeitaufwand") - - If rs.getBooleanValue("ReparaturErfolgreich") = True Then - - Else - - End If - - - strDurchfluesse = rs.getStringValue("Pruefpunkte") - strFehler = rs.getStringValue("Fehler") - - msfgPruefpunkte.cols = UBound(Split(strDurchfluesse, "|")) + 2 - For i = 1 To msfgPruefpunkte.cols - 1 - msfgPruefpunkte.col = i - msfgPruefpunkte.row = 0 - msfgPruefpunkte.text = Split(strDurchfluesse, "|")(i - 1) - msfgPruefpunkte.row = 1 - If i <= UBound(Split(strFehler, "|")) + 1 Then - msfgPruefpunkte.text = Split(strFehler, "|")(i - 1) - End If - Next - End If - - DoEvents - cmdSave.Enabled = False - - TestAufAusfallgrund - Exit Sub - -Errorhandler: - ErrorMsg "Fehler " & Err.Number & " beim Anzeigen des Rückläufers: " & Err.Description -End Sub - -Private Sub TestAufAusfallgrund() - If lstAusfallgrund.SelCount = 1 And InStr(lstAusfallgrund.List(lstAusfallgrund.ListIndex), "Ausfallursache ist unklar") > 0 Then - MsgBox ("Da die Ausfallursache unklar ist, sollten Sie einen anderen Ausfallgrund angeben, sobald er bekannt ist!") - End If -End Sub - -Private Sub txtAusfallgrund_Change() - Datengeaendert -End Sub - - - -Private Function PruefeAufPflichtfelder() As Boolean - Dim i As Integer - Dim blnAusgewaehlt As Boolean - - - blnAusgewaehlt = False - For i = 0 To lstAusfallgrund.ListCount - 1 - If lstAusfallgrund.Selected(i) = True Then - blnAusgewaehlt = True - End If - Next - - If blnAusgewaehlt = False Then - MsgBox "Bitte wählen Sie mindestens einen Ausfallgrund!", vbCritical - If lstAusfallgrund.Enabled = True Then - lstAusfallgrund.SetFocus - End If - PruefeAufPflichtfelder = False - Exit Function - End If - -' If Trim(txtAusfallgrund.text) = "" Then -' MsgBox "Bitte fßllen Sie das Feld 'sonstiges' aus!", vbCritical -' If txtAusfallgrund.Enabled = True Then -' txtAusfallgrund.SetFocus -' End If -' PruefeAufPflichtfelder = False -' Exit Function -' End If -' If Trim(txtReparaturmassnahme.text) = "" Then -' MsgBox "Bitte füllen Sie das Feld 'Reparaturmaßnahmen' aus!", vbCritical -' If txtReparaturmassnahme.Enabled = True Then -' txtReparaturmassnahme.SetFocus -' End If -' PruefeAufPflichtfelder = False -' Exit Function -' End If - - If Trim(txtZeitaufwand.text) = "" Then - MsgBox "Bitte füllen Sie das Feld 'Zeitaufwand' aus!", vbCritical - If txtZeitaufwand.Enabled = True Then - txtZeitaufwand.SetFocus - End If - PruefeAufPflichtfelder = False - Exit Function - End If - - PruefeAufPflichtfelder = True -End Function - -Private Sub txtReparaturmassnahme_Change() - Datengeaendert -End Sub - -Private Sub txtZeitaufwand_Change() - Datengeaendert -End Sub - - -Private Sub FilllstHistorie() - Dim strSQL As String - Dim rs As CRecordset - Dim lngGesZeit As Long - - Set rs = New CRecordset - strSQL = "SELECT * FROM Ruecklaeuferanalyse where SerienNr = " & m_Pruefzaehler.getSerienNr & " order by AnlageDatum" - rs.openRS strSQL, True - Set mcol_IDs = New Collection - lstHistorie.Clear - - Do While Not rs.EOF - lstHistorie.AddItem Format(rs.getIntValue("ID"), "0000000") & ") " & rs.getStringValue("AnlageDatum") '& " " & rs.getStringValue("Ausfallgrund") - mcol_IDs.Add rs.getIntValue("ID"), CStr(rs.getIntValue("ID")) - lngGesZeit = lngGesZeit + rs.getIntValue("Zeitaufwand") - rs.MoveNext - Loop - - - lstHistorie.AddItem NEU - - lstHistorie.Selected(lstHistorie.ListCount - 1) = True - - lblGesZeit.caption = lngGesZeit -End Sub - -Private Sub FelderSperren() - cmdSave.Enabled = False -End Sub - -Private Sub FelderEingabenZulassen() - -End Sub - -Private Sub txtZeitaufwand_KeyPress(KeyAscii As Integer) - Select Case KeyAscii - Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 8, 32, 13 - Case Else - Debug.Print KeyAscii & " " & Chr(KeyAscii) - KeyAscii = 0 - End Select -End Sub - - -''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' -Private Sub cmdPrint_Click() - Dim hoehe As Long - cmdPrint.Enabled = False - - Screen.MousePointer = vbHourglass - PrintProtokoll Printer - - DoEvents - cmdPrint.Enabled = True - Screen.MousePointer = vbNormal - -' Picture1.Visible = False -End Sub - -Private Sub PrintProtokoll(ByRef PrintObjekt As Object) - On Error GoTo Errorhandler - - Dim i As Integer - Dim lngID As Long - - If PrintObjekt Is Nothing Then Set PrintObjekt = Printer - PrintObjekt.ScaleMode = vbMillimeters - - Dim strSQL As String - Dim rs As CRecordset - Dim lngGesZeit As Long - Dim lngSeite As Long - Dim lngBlockNr As Long - Const ANZAHLPROSEITE = 1 - - Set rs = New CRecordset - strSQL = "SELECT * FROM VIEW_Ruecklaeuferanalyse where SerienNr = " & m_Pruefzaehler.getSerienNr & " order by AnlageDatum" - - - rs.openRS strSQL, True - - If Not rs.EOF Then - lngSeite = 1 - lngBlockNr = 1 - - Call PrintRahmen(PrintObjekt, lngSeite, rs.RecordCount) - Call PrintKopfdaten(PrintObjekt) - lngGesZeit = 0 - Do While Not rs.EOF - PrintAusfallBlock rs, PrintObjekt - lngGesZeit = lngGesZeit + rs.getLongValue("Zeitaufwand") - - rs.MoveNext - lngBlockNr = lngBlockNr + 1 - If lngBlockNr Mod ANZAHLPROSEITE = 0 Then - lngSeite = lngSeite + 1 - ' neue Seite - If Not rs.EOF Then - ' es gibt noch weitere Blßcke fßr weitere Seiten - If TypeName(PrintObjekt) = "Printer" Then - Printer.NewPage - Else - PrintObjekt.Cls - End If - Call PrintRahmen(PrintObjekt, lngSeite, rs.RecordCount) - Call PrintKopfdaten(PrintObjekt) - End If - End If - Loop - Else - MsgBox "Es gibt keine Rückläuferdaten zu diesem Zähler" - Printer.KillDoc - Exit Sub - End If - ' =================================================================================================================================== - ' === Prßfgang & Prßffehler ========================================================================================================= + ' === Prßfgang & Prßffehler ========================================================================================================= ' =================================================================================================================================== Dim recordset As CRecordset Dim evaluationsQuery As String @@ -1333,10 +59,10 @@ Private Sub PrintProtokoll(ByRef PrintObjekt As Object) ist(0) = recordset.getLongValue("Nr") If cols(0) < Printer.TextWidth(ist(0)) + 2 * offsetX Then - cols(0) = Printer.TextWidth("PrüfgangNr\Q[m³]") + 2 * offsetX + cols(0) = Printer.TextWidth("PrüfgangNr\Q[m³]") + 2 * offsetX End If - soll(0) = "Püfgang" + soll(0) = "Püfgang" For col = 1 To 10 p = recordset.getDoubleValue("P" & col) @@ -1402,12 +128,12 @@ Private Sub PrintProtokoll(ByRef PrintObjekt As Object) If row = 0 And col = 0 Then Printer.FontSize = 7 Printer.CurrentY = py - offsetY + 0.1 - Printer.CurrentX = px + (mw - Printer.TextWidth("Q[m³/h]")) - Printer.Print "Q[m³/h]" + Printer.CurrentX = px + (mw - Printer.TextWidth("Q[m³/h]")) + Printer.Print "Q[m³/h]" Printer.CurrentY = (py + lineH + offsetY) - Printer.TextHeight("|") Printer.CurrentX = px - Printer.Print "PrüfgangNr" + Printer.Print "PrüfgangNr" Else Printer.FontSize = 9 Printer.CurrentX = px + (mw - tw) / 2 @@ -1445,309 +171,5 @@ Private Sub PrintProtokoll(ByRef PrintObjekt As Object) mdblCurrentY = py End If ' =================================================================================================================================== - ' === Ende Prßfgang & Prßffehler ==================================================================================================== + ' === Ende Prßfgang & Prßffehler ==================================================================================================== ' =================================================================================================================================== - - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 - PrintObjekt.FontSize = 10 - - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "gesamter Zeitaufwand:", , True - PrintText PrintObjekt, mdblLinkerRand + 52, mdblCurrentY, lngGesZeit & " min", , False - - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 * 2 - PrintWithLinie PrintObjekt, "Befund / Reparatur-Maßnahme:" - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 * 2 - PrintWithLinie PrintObjekt, "" - - mdblCurrentY = mdblUntererRand - 20 - - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Unterschrift:", , True - PrintObjekt.Line (mdblLinkerRand + 10 + PrintObjekt.TextWidth("Unterschrift:"), mdblCurrentY + PrintObjekt.TextHeight("X"))-(mdblLinkerRand + 10 + PrintObjekt.TextWidth("Unterschrift:") + 50, mdblCurrentY + PrintObjekt.TextHeight("X")) - - PrintText PrintObjekt, mdblLinkerRand + 100, mdblCurrentY, "Datum:", , True - PrintObjekt.Line (mdblLinkerRand + 100 + PrintObjekt.TextWidth("Datum:"), mdblCurrentY + PrintObjekt.TextHeight("X"))-(mdblRechterRand - 20, mdblCurrentY + PrintObjekt.TextHeight("X")) - - If TypeName(PrintObjekt) = "Printer" Then - Printer.EndDoc - End If - Exit Sub - -Errorhandler: - 'If TypeName(PrintObjekt) = "Printer" Then - Printer.KillDoc - MsgBox "Fehler " & Err.Number & " in PrintProtokoll() : " & Err.Description - 'End If -End Sub - -Private Sub PrintWithLinie(PrintObjekt As Object, strText As String, Optional maxWidth As Variant) - - If IsMissing(maxWidth) Then - maxWidth = mdblRechterRand - 10 - Else - maxWidth = maxWidth + mdblLinkerRand + 10 + PrintObjekt.TextWidth(strText) - End If - - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, strText, , True - PrintObjekt.Line (mdblLinkerRand + 10 + PrintObjekt.TextWidth(strText), mdblCurrentY + PrintObjekt.TextHeight(strText))-(maxWidth, mdblCurrentY + PrintObjekt.TextHeight(strText)) -End Sub - -Private Sub PrintRahmen(ByRef PrintObjekt As Object, Optional lngSeitenNr As Long = 1, Optional lngAnzahlSeiten As Long = 1) - If PrintObjekt Is Nothing Then Set PrintObjekt = Printer - - mdblLinkerRand = 22 - mdblRechterRand = PrintObjekt.ScaleWidth - 5 - mdblObererRand = 10 - mdblUntererRand = PrintObjekt.ScaleHeight - 10 - mdblLinie1top = mdblObererRand + 20 - - PrintObjekt.Line (mdblLinkerRand, mdblObererRand)-(mdblRechterRand, mdblObererRand) - PrintObjekt.Line (mdblRechterRand, mdblObererRand)-(mdblRechterRand, mdblUntererRand) - PrintObjekt.Line (mdblRechterRand, mdblUntererRand)-(mdblLinkerRand, mdblUntererRand) - PrintObjekt.Line (mdblLinkerRand, mdblUntererRand)-(mdblLinkerRand, mdblObererRand) - - PrintObjekt.Line (mdblLinkerRand, mdblLinie1top)-(mdblRechterRand, mdblLinie1top) - - Dim dblBildbreite As Double - Dim dblBildhoehe As Double - - dblBildbreite = 45 - dblBildhoehe = dblBildbreite * ImgLogo.Height / ImgLogo.width - - PrintObjekt.PaintPicture ImgLogo.Picture, mdblLinkerRand + 2, mdblObererRand + 5, dblBildbreite, dblBildhoehe - ' Linie Vertikal rechts vom Bild - PrintObjekt.Line (mdblLinkerRand + dblBildbreite + 4, mdblObererRand)-(mdblLinkerRand + dblBildbreite + 4, mdblLinie1top) - ' Linie horizontal halbe Hßhe - PrintObjekt.Line (mdblLinkerRand + dblBildbreite + 4, mdblObererRand + 13)-(mdblRechterRand, mdblObererRand + 13) - - PrintObjekt.FontSize = 12 -' PrintText PrintObjekt, mdblLinkerRand + 75, mdblLinie1top - 18, "Anlage 2 zur", , False -' PrintText PrintObjekt, mdblLinkerRand + 65, mdblLinie1top - 12, "Arbeits- und Prßfanweisung", , True -' - PrintObjekt.FontSize = 12 - 'PrintText PrintObjekt, mdblLinkerRand + 95, mdblLinie1top - 6, "Rßcklßuferanalyse", , True - - PrintObjekt.Font.Bold = False - PrintTextAligned PrintObjekt, "Anlage 2 zur", mdblLinkerRand + dblBildbreite + 4, mdblLinkerRand + dblBildbreite + 100, mdblLinie1top - 18, vbCenter - PrintObjekt.Font.Bold = True - PrintTextAligned PrintObjekt, "ARBEITS- UND PRÜFANWEISUNG", mdblLinkerRand + dblBildbreite + 4, mdblLinkerRand + dblBildbreite + 100, mdblLinie1top - 12, vbCenter - - PrintTextAligned PrintObjekt, "Rückläuferanalyse", mdblLinkerRand + dblBildbreite + 4, mdblLinkerRand + dblBildbreite + 100, mdblLinie1top - 6, vbCenter - - ' vertikale Linie rechts , links neben Dokument-Nr - PrintObjekt.Line (mdblLinkerRand + dblBildbreite + 100, mdblObererRand)-(mdblLinkerRand + dblBildbreite + 100, mdblLinie1top) - - PrintObjekt.FontSize = 10 - PrintText PrintObjekt, mdblLinkerRand + 150, mdblObererRand + 1.5, "Dokument-Nr.:", , False - - PrintObjekt.FontSize = 14 - PrintText PrintObjekt, mdblLinkerRand + 150, mdblLinie1top - 13.5, "QA_M_037", , True - - PrintObjekt.FontSize = 10 - PrintTextAligned PrintObjekt, "Blatt: " & lngSeitenNr & " von " & lngAnzahlSeiten, mdblLinkerRand + 150, mdblRechterRand, mdblLinie1top - 6, vbCenter - - mdblCurrentY = mdblLinie1top - - PrintObjekt.CurrentX = mdblLinkerRand - PrintObjekt.CurrentY = mdblUntererRand + 1 - PrintObjekt.Font.Size = 8 - PrintObjekt.Print "gedruckt am " & Format(Now, "dd.mm.yyyy hh:mm:ss") & " von " & g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName - PrintObjekt.Font.Size = 12 -End Sub - -Private Sub PrintKopfdaten(ByRef PrintObjekt As Object) - If PrintObjekt Is Nothing Then Set PrintObjekt = Printer - - mdblCurrentY = mdblCurrentY + 10 - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Auftrag: ", False, True - PrintText PrintObjekt, mdblLinkerRand + 10 + 20, mdblCurrentY, m_objAuftrag.getNr & "/" & m_objAuftragPosition.getNr - PrintText PrintObjekt, mdblLinkerRand + 10 + 50, mdblCurrentY, "Kunde: ", False, True - PrintText PrintObjekt, mdblLinkerRand + 10 + 75, mdblCurrentY, m_objAuftrag.getKunde.getName - - mdblCurrentY = mdblCurrentY + Printer.TextHeight("X") - PrintText PrintObjekt, mdblLinkerRand + 10 + 75, mdblCurrentY, m_objAuftrag.getKunde.getOrt - - mdblCurrentY = mdblCurrentY + 10 - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Zählertyp:", , True - PrintText PrintObjekt, mdblLinkerRand + 10 + 25, mdblCurrentY, lblBezeichnung.caption - mdblCurrentY = mdblCurrentY + 10 - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Zählernummer:", , True - PrintText PrintObjekt, mdblLinkerRand + 10 + 35, mdblCurrentY, FormatSerienNr(lblSerienNr.caption), , True - - If m_objAuftragPositionSerienNr.getKundeneigeneSerienNr <> "" Then - PrintText PrintObjekt, mdblLinkerRand + 10 + 75, mdblCurrentY, "Kundeneigene SNr: ", , True - PrintText PrintObjekt, mdblLinkerRand + 10 + 120, mdblCurrentY, m_objAuftragPositionSerienNr.getKundeneigeneSerienNr, , True - End If - - - mdblCurrentY = mdblCurrentY + 5 - -End Sub - -Private Sub PrintAusfallBlock(rs As CRecordset, ByRef PrintObjekt As Object) - Dim dblLinksOben As Double - Dim dblRechtsOben As Double - Dim dblOben As Double - Dim blnHasPruefgang As Boolean - - If PrintObjekt Is Nothing Then Set PrintObjekt = Printer - dblLinksOben = mdblLinkerRand + 5 - dblRechtsOben = mdblRechterRand - 5 - mdblCurrentY = mdblCurrentY + 5 - dblOben = mdblCurrentY - - ' obere Linie - PrintObjekt.Line (dblLinksOben, mdblCurrentY)-(dblRechtsOben, mdblCurrentY) - PrintObjekt.Font.Size = 10 - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") - PrintText PrintObjekt, mdblLinkerRand + 12, mdblCurrentY, "Prüfstation: ", , True - PrintText PrintObjekt, mdblLinkerRand + 35, mdblCurrentY, rs.getIntValue("Pruefstation") - - PrintText PrintObjekt, mdblLinkerRand + 50, mdblCurrentY, "Zählerposition: ", , True - PrintText PrintObjekt, mdblLinkerRand + 80, mdblCurrentY, rs.getIntValue("Einbauplatz") - - PrintText PrintObjekt, mdblLinkerRand + 90, mdblCurrentY, "Prüfer: ", , True - PrintText PrintObjekt, mdblLinkerRand + 107, mdblCurrentY, rs.getStringValue("Pruefer") & " (" & rs.getStringValue("PrueferNr") & ")" - - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 - - If rs.getLongValue("PruefgangNr") <> 0 Then - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Prüfgang: ", , True - PrintText PrintObjekt, mdblLinkerRand + 30, mdblCurrentY, rs.getLongValue("PruefgangNr") - blnHasPruefgang = True - End If - - Dim strPruefpunkte As String - strPruefpunkte = Trim(rs.getStringValue("Pruefpunkte")) - If strPruefpunkte <> "" Then - blnHasPruefgang = True - Dim varTmp As Variant - Dim i As Integer - i = 1 - PrintText PrintObjekt, mdblLinkerRand + 80, mdblCurrentY, "Q [m³/h]" - PrintObjekt.Line (mdblLinkerRand + 80, mdblCurrentY + 5)-(mdblLinkerRand + 80 + 15, mdblCurrentY + 5) - PrintText PrintObjekt, mdblLinkerRand + 68, mdblCurrentY + 6, "Abweichung [%]" - - For Each varTmp In Split(strPruefpunkte, "|") - PrintObjekt.Line (mdblLinkerRand + 80 + i * 15, mdblCurrentY + 5)-(mdblLinkerRand + 80 + (i + 1) * 15, mdblCurrentY + 5) - PrintObjekt.Line (mdblLinkerRand + 80 + i * 15, mdblCurrentY)-(mdblLinkerRand + 80 + i * 15, mdblCurrentY + 10) - PrintText PrintObjekt, mdblLinkerRand + 70 + (i + 1) * 15, mdblCurrentY, varTmp - - Dim strFehler As String - - If i <= UBound(Split(rs.getStringValue("Fehler"), "|")) + 1 Then - strFehler = Split(rs.getStringValue("Fehler"), "|")(i - 1) - PrintText PrintObjekt, mdblLinkerRand + 70 + (i + 1) * 15, mdblCurrentY + 6, strFehler - End If - i = i + 1 - Next - End If - If blnHasPruefgang Then - mdblCurrentY = mdblCurrentY + 15 - End If - - If rs.getLongValue("FabNr") Then - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Geräte-Nr.:", True - PrintText PrintObjekt, mdblLinkerRand + 30, mdblCurrentY, rs.getLongValue("FabNr") - mdblCurrentY = mdblCurrentY + Printer.TextHeight("X") * 1.5 - End If - - - - '''''''''''''''''''''''''''' - Dim rsAusfall As CRecordset - Set rsAusfall = New CRecordset - - Dim strSQL As String - strSQL = "SELECT * FROM Ruecklaeufer_Ausfallgrund " - strSQL = strSQL & "INNER JOIN Ausfallgruende ON Ruecklaeufer_Ausfallgrund.Ausfallgrund_ID = Ausfallgruende.ID " - strSQL = strSQL & "WHERE (Ruecklaeufer_Ausfallgrund.Ruecklaufer_ID = " & rs.getIntValue("ID") & ") ORDER BY Ausfallgruende.Sortorder" - rsAusfall.openRS strSQL, True - If Not rs.EOF Then - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Ausfallgründe: ", , True - - Do While Not rsAusfall.EOF - PrintText PrintObjekt, mdblLinkerRand + 40, mdblCurrentY, rsAusfall.getStringValue("Text") - mdblCurrentY = mdblCurrentY + Printer.TextHeight("X") - rsAusfall.MoveNext - Loop - End If - - Dim ymax As Double - Dim strTemp As String - Dim varZeile As Variant - - strTemp = rs.getStringValue("sonstigerAusfallgrund") - If Trim(strTemp) <> "" Then - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 - For Each varZeile In Split(strTemp, vbCrLf) - ymax = mdblCurrentY + 40 - WrapText PrintObjekt, Trim(varZeile), mdblLinkerRand + 20, mdblRechterRand - 10, mdblCurrentY, ymax, False - mdblCurrentY = PrintObjekt.CurrentY - Next - End If - - mdblCurrentY = mdblCurrentY + 5 - - strTemp = rs.getStringValue("Befund") - If Trim(strTemp) <> "" Then - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Befund: ", , True - PrintObjekt.Font.Bold = False - mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 - For Each varZeile In Split(strTemp, vbCrLf) - ymax = mdblCurrentY + 40 - WrapText PrintObjekt, Trim(varZeile), mdblLinkerRand + 20, mdblRechterRand - 10, mdblCurrentY, ymax, False - mdblCurrentY = PrintObjekt.CurrentY - Next - End If - - mdblCurrentY = mdblCurrentY + 5 - PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Zeitaufwand:", , True - PrintText PrintObjekt, mdblLinkerRand + 45, mdblCurrentY, rs.getLongValue("Zeitaufwand") & " min", , False - mdblCurrentY = mdblCurrentY + 5 - - PrintObjekt.Line (dblLinksOben, mdblCurrentY)-(dblRechtsOben, mdblCurrentY) - PrintObjekt.Line (dblLinksOben, dblOben)-(dblLinksOben, mdblCurrentY) - PrintObjekt.Line (dblRechtsOben, dblOben)-(dblRechtsOben, mdblCurrentY) - - mdblCurrentY = mdblCurrentY + 5 -End Sub - -Private Sub SaveAusfallgruende(RuecklaeuferID As Long) - Dim rs As CRecordset - Dim blnIstSelected As Boolean - Dim i As Integer - - Dim lngAusfallgrundID As Long - - For i = 0 To lstAusfallgrund.ListCount - 1 - lngAusfallgrundID = val(lstAusfallgrund.List(i)) - - Set rs = New CRecordset - rs.openRS "SELECT * FROM Ruecklaeufer_Ausfallgrund where Ruecklaufer_ID=" & RuecklaeuferID & " and Ausfallgrund_ID=" & lngAusfallgrundID - If rs.EOF Then - ' kein Datensatz vorhanden - If lstAusfallgrund.Selected(i) = True Then - ' ist ausgewßhlt ? Dann als neu hinzufßgen - rs.addNew - rs.setValue "Ruecklaufer_ID", RuecklaeuferID - rs.setValue "Ausfallgrund_ID", lngAusfallgrundID - Debug.Print RuecklaeuferID & "/" & lngAusfallgrundID & " neu" - rs.update - Else - 'Debug.Print RuecklaeuferID & "/" & lngAusfallgrundID & " bleibt draußen" - End If - Else - ' Datensatz vorhanden - If lstAusfallgrund.Selected(i) = True Then - - Else - Debug.Print RuecklaeuferID & "/" & lngAusfallgrundID & " wird gelöscht" - rs.delete - rs.update - End If - End If - Next - -End Sub - -