Initial commit 3
This commit is contained in:
Rowlander
@@ -0,0 +1,314 @@
|
||||
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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user