VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX" Begin VB.Form frmTrefferquotenueberwachung Caption = "Pruef2000 Trefferquotenüberpruefung" ClientHeight = 5985 ClientLeft = 60 ClientTop = 345 ClientWidth = 7050 LinkTopic = "Form2" ScaleHeight = 5985 ScaleWidth = 7050 StartUpPosition = 3 'Windows-Standard Begin VB.CommandButton cmdDrucken Caption = "Drucken" Height = 375 Left = 4380 TabIndex = 6 Top = 5070 Width = 855 End Begin VB.TextBox txtAusgabe Height = 2685 Left = 30 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertikal TabIndex = 5 Top = 30 Width = 6975 End Begin MSComctlLib.ProgressBar ProgressBar1 Height = 225 Left = 0 TabIndex = 3 Top = 5430 Width = 6975 _ExtentX = 12303 _ExtentY = 397 _Version = 393216 Appearance = 1 End Begin VB.CommandButton cmdOK Caption = "Schließen" Height = 405 Left = 2700 TabIndex = 2 Top = 5070 Width = 1485 End Begin VB.TextBox txtGrund Height = 1305 Left = 90 TabIndex = 1 Top = 3630 Width = 6825 End Begin MSComctlLib.StatusBar StatusBar1 Align = 2 'Unten ausrichten Height = 315 Left = 0 TabIndex = 0 Top = 5670 Width = 7050 _ExtentX = 12435 _ExtentY = 556 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.Label lblUrsache Height = 795 Left = 120 TabIndex = 4 Top = 2760 Width = 6855 End End Attribute VB_Name = "frmTrefferquotenueberwachung" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private m_blnActivated As Boolean Public m_lngAuftragNr As Long Public m_intPositionNr As Integer Public m_blnSendeMail As Boolean Private Sub cmdDrucken_Click() Dim strText As String Me.MousePointer = vbHourglass cmdDrucken.Enabled = False strText = txtAusgabe.text & vbCrLf If m_blnSendeMail = True Then If Trim(txtGrund.text) <> "" Then strText = strText & "Der Prüfer " & g_App.Mitarbeiter.getAnfangsbuchstabeVornameundName & " gab an der Prüfstation " & g_App.PruefstationNr & " folgende Vermutung über die Ursache an:" & vbCrLf & "---" & vbCrLf & txtGrund.text & vbCrLf & "---" & vbCrLf Else strText = strText & "Der Prüfer " & g_App.Mitarbeiter.getAnfangsbuchstabeVornameundName & " gab an der Prüfstation " & g_App.PruefstationNr & " keine Vermutung über die Ursache an." & vbCrLf End If End If Printer.ScaleMode = vbMillimeters Printer.Font.Size = 8 Printer.ScaleLeft = -15 Printer.ScaleTop = -20 Printer.Print "" Printer.Print strText Printer.EndDoc Me.MousePointer = vbNormal MsgBox "Das Trefferquoten-Ergebnis wurde gedruckt!" cmdDrucken.Enabled = True End Sub Private Sub cmdOk_Click() Dim strText As String Me.MousePointer = vbHourglass If m_blnSendeMail = True Then strText = txtAusgabe.text & vbCrLf If Trim(txtGrund.text) <> "" Then strText = strText & "Der Prüfer " & g_App.Mitarbeiter.getAnfangsbuchstabeVornameundName & " gab an der Prüfstation " & g_App.PruefstationNr & " folgende Vermutung über die Ursache an:" & vbCrLf & "---" & vbCrLf & txtGrund.text & vbCrLf & "---" & vbCrLf Else strText = strText & "Der Prüfer " & g_App.Mitarbeiter.getAnfangsbuchstabeVornameundName & " gab an der Prüfstation " & g_App.PruefstationNr & " keine Vermutung über die Ursache an." & vbCrLf End If strText = strText & "Diese Mail wurde automatisch von Pruef2000.exe generiert." If InStr(1, g_App.getDB.getConnection.ConnectionString, "Testreplikation") = 0 Then SendMail "nobody@sensus.com", "Arno.Schramm@sensus.com;Juergen.Dreyer@sensus.com;Manfred.Born@sensus.com;sixSigma.Laatzen@sensus.com", "Trefferquote für Auftragposition " & m_lngAuftragNr & "/" & m_intPositionNr & " wurde unterschritten!", strText StatusBar1.SimpleText = "Mail wurde versendet!" Sleep 1000, True Else Me.MousePointer = vbNormal MsgBox "Diese Mail würde versendet werden: " & vbCrLf & strText End If End If Me.MousePointer = vbNormal Unload Me End Sub Private Sub Form_Activate() If m_blnActivated = False Then UeberpruefeTrefferquote m_lngAuftragNr, m_intPositionNr, m_blnSendeMail Me.MousePointer = vbNormal Screen.MousePointer = vbNormal End If m_blnActivated = True End Sub Private Sub Form_Load() cmdDrucken.Enabled = False cmdOK.Enabled = False txtGrund.Visible = False End Sub Private Sub Form_Resize() txtAusgabe.Top = 0 txtAusgabe.Left = 0 txtAusgabe.Width = Me.ScaleWidth Debug.Print "Me.Width=" & Me.Width & ", Me.Height=" & Me.Height cmdOK.Left = (Me.ScaleWidth - cmdOK) / 2 cmdOK.Top = Me.ScaleHeight - StatusBar1.Height - cmdOK.Height * 1.5 cmdOK.Left = (Me.ScaleWidth - cmdOK.Width) / 2 cmdDrucken.Left = cmdOK.Left + 1.3 * cmdOK.Width cmdDrucken.Top = cmdOK.Top txtGrund.Top = cmdOK.Top - txtGrund.Height - cmdOK.Height / 2 txtGrund.Width = Me.ScaleWidth txtGrund.Left = 0 ProgressBar1.Left = 0 ProgressBar1.Top = Me.ScaleHeight - StatusBar1.Height - ProgressBar1.Height ProgressBar1.Width = Me.ScaleWidth txtAusgabe.Height = txtGrund.Top - lblUrsache.Height * 1.1 lblUrsache.Top = txtAusgabe.Top + txtAusgabe.Height + lblUrsache.Height / 4 End Sub Private Sub UeberpruefeTrefferquote(lngAuftragNr As Long, intPosNr As Integer, ByRef blnSendeMail As Boolean) On Error GoTo Errorhandler Dim dblTrefferquoteAuftrag As Double Dim dblTrefferquoteZaehler As Double Dim strText As String Dim AnzahlZaehler As Long Dim AnzahlZaehlerAuftragPosition As Long Dim AuftragPosition As CAuftragPosition Dim lngAnzahlWiederholungenAuftrag As Long Dim objIdentNr As CIdentNr Set AuftragPosition = New CAuftragPosition AuftragPosition.load lngAuftragNr, intPosNr Set objIdentNr = AuftragPosition.getIdentNrObj Me.MousePointer = vbHourglass lblUrsache.Visible = False strText = "" StatusBar1.SimpleText = "überprüfe Trefferquote der Auftragsposition..." ProgressBar1.Visible = True dblTrefferquoteAuftrag = Trefferquote(lngAuftragNr, intPosNr, , , , , , , ProgressBar1, , AnzahlZaehlerAuftragPosition, lngAnzahlWiederholungenAuftrag) strText = strText & "Auftragposition " & lngAuftragNr & "/" & intPosNr & vbCrLf strText = strText & " Auftragsmenge: " & AuftragPosition.getMenge & vbCrLf strText = strText & " Trefferquote=" & dblTrefferquoteAuftrag & " %" & vbCrLf strText = strText & " Wiederholungen=" & lngAnzahlWiederholungenAuftrag & vbCrLf strText = strText & vbCrLf txtAusgabe.text = strText DoEvents StatusBar1.SimpleText = "überprüfe Trefferquote des Zählertyps..." dblTrefferquoteZaehler = Trefferquote(, , Now - 183, Now - 1, objIdentNr.getTyp, objIdentNr.getNennweite, objIdentNr.GetTemperatur, AuftragPosition.getMetrolog, ProgressBar1, , AnzahlZaehler) strText = strText & "Zählertyp " & objIdentNr.getTyp & " " & objIdentNr.getNennweite & " " & objIdentNr.GetTemperatur & "°C, Metrolog=" & AuftragPosition.getMetrolog & vbCrLf strText = strText & " Trefferquote=" & dblTrefferquoteZaehler & " %" & vbCrLf strText = strText & " (Zeitraum: 1/2 Jahr, " & AnzahlZaehler & " Zähler)" & vbCrLf strText = strText & vbCrLf txtAusgabe.text = strText DoEvents StatusBar1.SimpleText = "" ProgressBar1.Visible = False Me.MousePointer = vbNormal cmdOK.Enabled = True cmdOK.Visible = True cmdDrucken.Enabled = True If AuftragPosition.getMenge >= 20 And dblTrefferquoteAuftrag > 0 And AnzahlZaehlerAuftragPosition > 20 And AnzahlZaehler >= 100 Then If dblTrefferquoteZaehler > 0 Then If dblTrefferquoteAuftrag < dblTrefferquoteZaehler - 10 Then strText = strText & "Die Trefferquote der Auftragposition ist mind. 10% kleiner als die Halbjahresdurchschnitts-Trefferquote des Zählertypes und der Metrolog!" & vbCrLf strText = strText & vbCrLf txtAusgabe.BackColor = RGB(255, 200, 200) LogIntoDB "Trefferquote für Auftragposition " & lngAuftragNr & "/" & intPosNr & " wurde unterschritten!", "Trefferquote" txtAusgabe.text = strText DoEvents If m_blnSendeMail = True Then txtGrund.Visible = True lblUrsache.Visible = True lblUrsache.caption = "Diese Info wird an die QS übermittelt." & vbCrLf & vbCrLf lblUrsache.caption = lblUrsache.caption & "Hier haben Sie die Möglichkeit Vermutungen über die Ursache einzugeben:" End If Exit Sub Else strText = strText & "Die Trefferquote " & dblTrefferquoteAuftrag & "% (Auftragsposition) ist OK." txtAusgabe.BackColor = RGB(200, 255, 200) blnSendeMail = False End If Else blnSendeMail = False txtAusgabe.text = txtAusgabe.text & "Die Trefferquote des Zählertyps ist nicht ermittelbar (=0) für " & objIdentNr.getTyp & " " & objIdentNr.getNennweite & " " & objIdentNr.GetTemperatur & "°C" LogIntoDB "Trefferquote des Zählers ist nicht ermittelbar: " & objIdentNr.getTyp & " " & objIdentNr.getNennweite & " " & objIdentNr.GetTemperatur & "°C", "Trefferquote" Exit Sub End If Else blnSendeMail = False If dblTrefferquoteAuftrag <= 0 Then txtAusgabe.text = txtAusgabe.text & "Die Trefferquote der Auftragposition ist nicht ermittelbar " & lngAuftragNr & "/" & intPosNr & "." Sleep 5000, True Unload Me Exit Sub End If If AnzahlZaehler < 100 Then txtAusgabe.text = txtAusgabe.text & "Zuwenig Zähler (<100) im letzten halben Jahr für einen Trefferquotenvergleich!" Sleep 5000, True Unload Me Exit Sub End If If AuftragPosition.getMenge < 20 Then txtAusgabe.text = txtAusgabe.text & "Die Auftragsmenge ist zu klein (< 20) für einen Trefferquotenvergleich!" Sleep 5000, True Unload Me Exit Sub End If If AnzahlZaehlerAuftragPosition < 20 Then txtAusgabe.text = "Die geprüfte Menge ist zu klein (< 20) für einen Trefferquotenvergleich!" Sleep 5000, True Unload Me Exit Sub End If End If txtAusgabe.text = strText cmdOK.Default = True ' Dim i As Integer ' For i = 60 To 1 Step -1 ' cmdOK.Caption = " Schließen in " & i & " s" ' Sleep 1000, True ' Next ' Unload Me Exit Sub Errorhandler: LogIntoDB "Fehler " & Err.Number & " in UeberpruefeTrefferquote: " & Err.Description, "Fehler" blnSendeMail = False End Sub