383 lines
13 KiB
Plaintext
383 lines
13 KiB
Plaintext
VERSION 5.00
|
|
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmPruefergebnisse
|
|
Caption = "Prüfergebnisse für die Zähler mit Grenzwertüberschreitung"
|
|
ClientHeight = 5820
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 7710
|
|
LinkTopic = "Form2"
|
|
ScaleHeight = 5820
|
|
ScaleWidth = 7710
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.CheckBox chkNur25
|
|
Caption = "nur mit Grenzwertüberschreitung"
|
|
Height = 495
|
|
Left = 4890
|
|
TabIndex = 4
|
|
ToolTipText = "Wenn diese Option aktiviert ist, werden nur die Prüfergebnisse mit Grenzwertüberschreitung angezeigt"
|
|
Top = 4950
|
|
Value = 1 'Aktiviert
|
|
Width = 2415
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 315
|
|
Left = 0
|
|
TabIndex = 3
|
|
Top = 5505
|
|
Width = 7710
|
|
_ExtentX = 13600
|
|
_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.CommandButton cmdClose
|
|
Caption = "OK"
|
|
Height = 435
|
|
Left = 3090
|
|
TabIndex = 2
|
|
Top = 4980
|
|
Width = 1605
|
|
End
|
|
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
|
|
Height = 4035
|
|
Left = 90
|
|
TabIndex = 0
|
|
Top = 780
|
|
Width = 7215
|
|
_ExtentX = 12726
|
|
_ExtentY = 7117
|
|
_Version = 393216
|
|
AllowUserResizing= 3
|
|
End
|
|
Begin VB.Label lblAutoSize
|
|
AutoSize = -1 'True
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "AUTOFIT"
|
|
Height = 255
|
|
Left = 630
|
|
TabIndex = 5
|
|
Top = 4920
|
|
Width = 750
|
|
End
|
|
Begin VB.Label lblHeader
|
|
Caption = "Label1"
|
|
Height = 645
|
|
Left = 90
|
|
TabIndex = 1
|
|
Top = 60
|
|
Width = 7185
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmPruefergebnisse"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Public m_lngAuftragNr As Long
|
|
Public m_intPosNr As Integer
|
|
Private mblnIsActivated As Boolean
|
|
|
|
|
|
Private m_AuftragPosition As CAuftragPosition
|
|
Private m_AuftragPositionSerienNr As CAuftragPosition
|
|
|
|
Private Sub chkNur25_Click()
|
|
Call AktualisiereFurZaehlerMitGrenzwertueberschreitung
|
|
End Sub
|
|
|
|
Private Sub cmdClose_Click()
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
If Not mblnIsActivated Then
|
|
mblnIsActivated = True
|
|
Call AktualisiereFurZaehlerMitGrenzwertueberschreitung
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
mblnIsActivated = False
|
|
End Sub
|
|
|
|
|
|
Private Sub ZeigePrueffehlerInGrid()
|
|
Me.Enabled = False
|
|
Screen.MousePointer = vbHourglass
|
|
|
|
Me.Caption = "Prüfergebnisse der Zähler eines Auftrages"
|
|
lblHeader.Caption = "Auftrag :" & m_lngAuftragNr & " / " & m_intPosNr
|
|
|
|
' alle Prüfpunkte bestimmen und sortieren
|
|
|
|
|
|
|
|
|
|
Me.Enabled = True
|
|
Screen.MousePointer = vbNormal
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub AktualisiereFurZaehlerMitGrenzwertueberschreitung()
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Dim IdentNrObj As CIdentNr
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
Me.Enabled = False
|
|
Screen.MousePointer = vbHourglass
|
|
|
|
|
|
Me.Caption = "Prüfergebnisse der Zähler (mit Grenzwertüberschreitung)"
|
|
lblHeader.Caption = "Auftrag :" & m_lngAuftragNr & " / " & m_intPosNr
|
|
|
|
Set AuftragPosition = New CAuftragPosition
|
|
If AuftragPosition.load(m_lngAuftragNr, m_intPosNr) Then
|
|
Set IdentNrObj = New CIdentNr
|
|
If IdentNrObj.load(AuftragPosition.getIdentNr) Then
|
|
lblHeader.Caption = lblHeader.Caption & vbCrLf & IdentNrObj.getTyp & " " & IdentNrObj.getTypzusatz & " " & IdentNrObj.getNennweite & " " & IdentNrObj.GetTemperatur & "°C / PN" & IdentNrObj.getDruck
|
|
End If
|
|
End If
|
|
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim intZeile As Integer
|
|
Dim rsFehler As CRecordset
|
|
|
|
Dim lngWiederholungen As Long
|
|
Dim lngSerienNr As Long
|
|
Dim dblQ As Double
|
|
Dim intSpalte As Integer
|
|
Dim i As Integer
|
|
Dim dblFehler As Double
|
|
Dim dblFGo As Double
|
|
Dim dblFGu As Double
|
|
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim Pruefpunkte As CPruefpunkte
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim Pruefgangdatum As Date
|
|
Dim PPNr As Integer
|
|
|
|
|
|
' letzte Prüfung einer SerienNr
|
|
sSQL = "SELECT SerienNr, MAX(Wiederholungen) AS MaxWdh "
|
|
sSQL = sSQL & "FROM AuftragPositionSerienNr "
|
|
sSQL = sSQL & "WHERE (AuftragNr = " & m_lngAuftragNr & ") AND (PositionNr = " & m_intPosNr & ") AND (Wiederholungen >= 0)"
|
|
sSQL = sSQL & "GROUP BY SerienNr ORDER BY SerienNr"
|
|
|
|
Set rs = New CRecordset
|
|
|
|
Debug.Print sSQL
|
|
MSFlexGrid1.Clear
|
|
|
|
rs.openRS sSQL, True
|
|
MSFlexGrid1.Font.Size = 12
|
|
|
|
' (Q, Fo, Fu = FixedRows + 1 = 4
|
|
MSFlexGrid1.Rows = 4
|
|
' SerienNr
|
|
MSFlexGrid1.Cols = 2
|
|
|
|
MSFlexGrid1.FixedCols = 1
|
|
MSFlexGrid1.FixedRows = 3
|
|
|
|
MSFlexGrid1.row = 0
|
|
MSFlexGrid1.col = 0
|
|
MSFlexGrid1.CellFontBold = True
|
|
MSFlexGrid1.text = "Q"
|
|
MSFlexGrid1.row = 1
|
|
MSFlexGrid1.CellFontBold = True
|
|
MSFlexGrid1.text = "FGo"
|
|
MSFlexGrid1.row = 2
|
|
MSFlexGrid1.CellFontBold = True
|
|
MSFlexGrid1.text = "FGu"
|
|
|
|
MSFlexGrid1.ColWidth(0) = 1650
|
|
|
|
intZeile = 1
|
|
|
|
|
|
If Not rs.EOF Then
|
|
|
|
lngSerienNr = rs.getLongValue("SerienNr")
|
|
lngWiederholungen = rs.getLongValue("MaxWdh")
|
|
Debug.Print lngSerienNr & " Wdh " & lngWiederholungen
|
|
|
|
Set Pruefzaehler = New CPruefzaehler
|
|
If Pruefzaehler.loadForSerienNr(lngSerienNr) Then
|
|
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
|
|
If Not Pruefpunkte Is Nothing Then
|
|
For i = 1 To Pruefpunkte.getPruefpunkteCount
|
|
Set Pruefpunkt = Pruefpunkte.getPruefpunkt(i)
|
|
If Pruefpunkt Is Nothing Then
|
|
Debug.Print "Pruefpunkt " & i & " wird ausgelassen"
|
|
Else
|
|
PPNr = PPNr + 1
|
|
If i + 1 > MSFlexGrid1.Cols Then
|
|
MSFlexGrid1.Cols = i + 2
|
|
End If
|
|
MSFlexGrid1.col = i
|
|
MSFlexGrid1.row = 0
|
|
MSFlexGrid1.CellFontBold = True
|
|
MSFlexGrid1.text = Format(Pruefpunkt.getQ, "0.0####")
|
|
MSFlexGrid1.row = 1
|
|
MSFlexGrid1.text = Round(Pruefpunkt.getFGo, 2)
|
|
MSFlexGrid1.row = 2
|
|
MSFlexGrid1.text = Round(Pruefpunkt.getFGu, 2)
|
|
|
|
Debug.Print ""
|
|
End If
|
|
|
|
Next
|
|
Else
|
|
MsgBox "Es gibt keine Prüfpunkte"
|
|
Me.Enabled = False
|
|
Screen.MousePointer = vbNormal
|
|
Unload Me
|
|
Exit Sub
|
|
End If
|
|
|
|
MSFlexGrid1.row = 0
|
|
MSFlexGrid1.Cols = i + 1
|
|
MSFlexGrid1.col = i
|
|
MSFlexGrid1.text = "Prüfdatum"
|
|
MSFlexGrid1.CellFontBold = True
|
|
End If
|
|
End If
|
|
DoEvents
|
|
|
|
Do While Not rs.EOF
|
|
'MSFlexGrid1.Rows = intZeile + 3
|
|
|
|
' alle Geprüften SerienNummern
|
|
lngSerienNr = rs.getLongValue("SerienNr")
|
|
lngWiederholungen = rs.getLongValue("MaxWdh")
|
|
|
|
Dim rs1 As CRecordset
|
|
Set rs1 = New CRecordset
|
|
|
|
sSQL = "SELECT * FROM AuftragPositionSerienNr "
|
|
sSQL = sSQL & "INNER JOIN Prueffehler ON AuftragPositionSerienNr.SerienNr = Prueffehler.SerienNr AND AuftragPositionSerienNr.Pruefgangnr = Prueffehler.PruefgangNr "
|
|
sSQL = sSQL & "INNER JOIN Pruefgang ON AuftragPositionSerienNr.Pruefgangnr = Pruefgang.PruefgangNr AND Prueffehler.PruefgangNr = Pruefgang.PruefgangNr "
|
|
|
|
If chkNur25.Value = vbChecked Then
|
|
sSQL = sSQL & "WHERE (AuftragPositionSerienNr.SerienNr = " & lngSerienNr & ") And (AuftragPositionSerienNr.Wiederholungen = " & lngWiederholungen & ") AND (AuftragPositionSerienNr.StatusFertigung = 25) "
|
|
Else
|
|
sSQL = sSQL & "WHERE (AuftragPositionSerienNr.SerienNr = " & lngSerienNr & ") And (AuftragPositionSerienNr.Wiederholungen = " & lngWiederholungen & ") "
|
|
End If
|
|
|
|
Set rsFehler = New CRecordset
|
|
rsFehler.openRS sSQL, True
|
|
|
|
Debug.Print sSQL
|
|
|
|
|
|
If rsFehler.RecordCount > 0 Then
|
|
|
|
Pruefgangdatum = rsFehler.getDateValue("PruefgangDatum")
|
|
' Fehler Datensatz vorhanden
|
|
|
|
MSFlexGrid1.Rows = intZeile + 3
|
|
MSFlexGrid1.row = intZeile + 2
|
|
|
|
MSFlexGrid1.col = 0
|
|
|
|
|
|
MSFlexGrid1.text = "(" & intZeile & ") " & lngSerienNr
|
|
|
|
PPNr = 0
|
|
For i = 1 To 10
|
|
If Not rsFehler.isFieldNull("PP" & i & "_Fehler") Then
|
|
' Fehler ist für diesen Datensatz vorhanden
|
|
PPNr = PPNr + 1
|
|
|
|
If PPNr >= MSFlexGrid1.Cols Then
|
|
' Spaltenanzahl erhöhen
|
|
MSFlexGrid1.Cols = PPNr + 1
|
|
End If
|
|
|
|
MSFlexGrid1.col = PPNr
|
|
MSFlexGrid1.CellFontBold = False
|
|
|
|
dblFehler = rsFehler.getDoubleValue("PP" & i & "_Fehler")
|
|
If Not Pruefpunkte Is Nothing Then
|
|
Set Pruefpunkt = Pruefpunkte.getPruefpunkte.getPP(Round(rsFehler.getDoubleValue("PP" & i & "_Soll"), 5))
|
|
If Not Pruefpunkt Is Nothing Then
|
|
If GrenzwertUeberschritten(Pruefpunkt.getFGo, dblFehler, Pruefpunkt.getFGu) Then
|
|
MSFlexGrid1.CellBackColor = vbYellow
|
|
End If
|
|
MSFlexGrid1.text = Format(dblFehler, "0.0#")
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
' MSFlexGrid1.Cols = Pruefpunkte.getPruefpunkteCount + 2
|
|
' MSFlexGrid1.Col = Pruefpunkte.getPruefpunkteCount + 1
|
|
MSFlexGrid1.Cols = PPNr + 2
|
|
MSFlexGrid1.col = PPNr + 1
|
|
MSFlexGrid1.text = Format(Pruefgangdatum, "dd.mm.yyyy hh:mm")
|
|
intZeile = intZeile + 1
|
|
End If
|
|
rs.MoveNext
|
|
Loop
|
|
Me.Enabled = True
|
|
Screen.MousePointer = vbNormal
|
|
|
|
Dim lngBreite As Long
|
|
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
|
|
For i = 0 To MSFlexGrid1.Cols - 1
|
|
If i < 9 Then
|
|
lngBreite = lngBreite + MSFlexGrid1.ColWidth(i)
|
|
If lngBreite > Me.Width Then
|
|
Me.Width = lngBreite + TwipsPerPixelX(40)
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
Exit Sub
|
|
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " in Funktion AktualisiereFurZaehlerMitGrenzwertueberschreitung: " & 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
|
|
|
|
Private Sub Form_Resize()
|
|
On Error Resume Next
|
|
lblHeader.Left = Me.ScaleLeft
|
|
lblHeader.Top = Me.ScaleTop
|
|
lblHeader.Width = Me.ScaleWidth
|
|
|
|
MSFlexGrid1.Top = Me.ScaleTop + lblHeader.Height
|
|
MSFlexGrid1.Left = Me.ScaleLeft
|
|
MSFlexGrid1.Width = Me.ScaleWidth
|
|
|
|
cmdClose.Top = Me.ScaleHeight - cmdClose.Height - TwipsPerPixelY(10) - StatusBar1.Height
|
|
cmdClose.Left = Me.ScaleLeft + Me.ScaleWidth / 2 - cmdClose.Width / 2
|
|
|
|
chkNur25.Left = cmdClose.Left + cmdClose.Width + TwipsPerPixelX(10)
|
|
chkNur25.Top = cmdClose.Top
|
|
|
|
MSFlexGrid1.Height = cmdClose.Top - MSFlexGrid1.Top
|
|
|
|
End Sub
|
|
|