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