315 lines
12 KiB
Plaintext
315 lines
12 KiB
Plaintext
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
|
|
|
|
|