VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX" Begin VB.Form frmReferenzzaehlerPruefpunkte Caption = " Prüfpunkt Auswahl für die Referenzzählerprüfung" ClientHeight = 8190 ClientLeft = 60 ClientTop = 345 ClientWidth = 11925 LinkTopic = "Form1" ScaleHeight = 8190 ScaleWidth = 11925 StartUpPosition = 3 'Windows-Standard Begin VB.CommandButton cmdPruefstationAendern Caption = "..." Height = 255 Left = 6765 TabIndex = 15 ToolTipText = "Sperre für die PrüfstationsNr Wahl aufheben" Top = 510 Width = 345 End Begin VB.Timer Timer1 Left = 11430 Top = 330 End Begin VB.ComboBox cmbPruefstationNr Height = 315 Left = 5175 Style = 2 'Dropdown-Liste TabIndex = 12 Top = 480 Width = 1515 End Begin MSComctlLib.StatusBar StatusBar1 Align = 2 'Unten ausrichten Height = 300 Left = 0 TabIndex = 8 Top = 7890 Width = 11925 _ExtentX = 21034 _ExtentY = 529 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 cmdNeueinlesen Caption = "Reset" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 3795 TabIndex = 7 ToolTipText = "Verwerfen der Änderungen und erneutes Einlesen der Prüfpunkte" Top = 7260 Width = 1755 End Begin VB.CommandButton cmdSave Caption = "Speichern" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 5760 TabIndex = 6 ToolTipText = "Speichern der Änderungen" Top = 7275 Width = 1755 End Begin VB.OptionButton optPruefergruppe Caption = "Versuch" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 0 TabIndex = 4 Top = 450 Width = 2835 End Begin VB.OptionButton optPruefergruppe Caption = "Produktion" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 15 TabIndex = 3 Top = 45 Width = 2835 End Begin VB.Frame frameStrang Caption = "Nennweite" Height = 6285 Index = 0 Left = 30 TabIndex = 1 Top = 840 Visible = 0 'False Width = 2115 Begin MSComctlLib.ListView LstviewPruefpunkte Height = 4245 Index = 0 Left = 120 TabIndex = 9 Top = 495 Width = 1860 _ExtentX = 3281 _ExtentY = 7488 View = 3 LabelEdit = 1 LabelWrap = -1 'True HideSelection = -1 'True Checkboxes = -1 'True GridLines = -1 'True _Version = 393217 ForeColor = -2147483640 BackColor = -2147483643 BorderStyle = 1 Appearance = 1 NumItems = 0 End Begin VB.CheckBox chkStrang Caption = "alle aus/abwählen" Height = 375 Index = 0 Left = 165 TabIndex = 5 Top = 5775 Width = 1755 End Begin VB.Label lblNennweite Caption = "NW" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 0 Left = 1020 TabIndex = 2 Top = 165 Width = 1035 End Begin VB.Label lblRZInfo BorderStyle = 1 'Fest Einfach Height = 930 Index = 0 Left = 135 TabIndex = 11 Top = 4755 Width = 1845 End End Begin VB.CommandButton cmdSchliessen Caption = "Schliessen" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 9780 TabIndex = 0 ToolTipText = "Beenden und Schliessen des Formulars" Top = 7260 Width = 1755 End Begin VB.Label lblZeitTotal Height = 360 Left = 45 TabIndex = 14 Top = 7380 Width = 3510 End Begin VB.Label Label1 Caption = "für Prüfstation" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3315 TabIndex = 13 Top = 480 Width = 1905 End Begin VB.Label lblUeberschrift Caption = "Referenzprüfpunkte für Versuch/Produktion" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Left = 2910 TabIndex = 10 Top = 45 Width = 8865 End End Attribute VB_Name = "frmReferenzzaehlerPruefpunkte" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Const CONST_Produktion = "PRODUKTION" Const CONST_Versuch = "VERSUCH" ' gibt an, ob die Referenzzählerprüfpunkte für den Versuch oder die Produktion bearbeitet werden. Ein Prüfstellenleiter darf nämlich beides Private m_blnProduktion As Boolean ' gibt an, ob eine Änderung stattgefunden hat, die gespeichert oder verworfen werden müsste, ' Es wird ein Dialog angezeigt, wenn das Formular geschlossen wird. Private m_blnGeaendert As Boolean Private m_bActivated As Boolean Private m_lngPruefstationNr As Long Private m_lngSekundenTotal As Long ' alle Datensätze in ReferenzzaehlerPruefpunkt mit der Eigenschaft Pflichtpruefpunkte=1 sind die Pflichtprüfpunkte für die Produktion ' Wenn ein Strang für die Referenzzählerprüfung der Produktion abgewählt wird, werden alle Prüfpunkte des Stranges mit Ausfuehren=1 auf Ausfuehren gesetzt. ' Deshalb gibt es zwei Speicher-Funktionen. ' Für den Versuch: Haken berücksichtigen ' Für die Produktion gilt: ' Strang für Produktion einschalten (Die Produiktion führt nur Pflichtprüfpunkte aus) ' update ReferenzzaehlerPruefpunkt set Ausfuehren = Pflichtpruefpunkt ' Where Herkunft like '20xx-032-A" oder SerienNr in (select SerienNr from Referenzzaehler where Pruefstation = 20xx and Nennweite = xx) ' Strang für Produktion ausschalten (Die Produiktion führt nur Pflichtprüfpunkte aus) ' update ReferenzzaehlerPruefpunkt set Ausfuehren = 0 ' Where Herkunft like '20xx-032-A" oder SerienNr in (select SerienNr from Referenzzaehler where Pruefstation = 20xx and Nennweite = xx) ' Für den Versuch gilt: ' Der Versuch bekommt eine eigene Ausführen-Spalte [Ausfuehren_Versuch] ' Prüfpunkte für Versuch einschalten ' update ReferenzzaehlerPruefpunkt set Ausfuehren_Versuch = [Haken ja/nein] ' Where SerienNr = ... ' Der Haken für den gesamten Strang wurde angeklickt Private Sub chkStrang_Click(Index As Integer) If chkStrang(Index).Enabled = False Then Exit Sub Dim i As Integer If chkStrang(Index).value = vbChecked Then ' kompletter Strang angewählt: Alle Prüfpunkt-Haken setzen For i = 1 To LstviewPruefpunkte(Index).ListItems.Count LstviewPruefpunkte(Index).ListItems(i).Checked = True Next Else ' kompletter Strang NICHT angewählt: Alle Prüfpunkt-Haken entfernen For i = 1 To LstviewPruefpunkte(Index).ListItems.Count LstviewPruefpunkte(Index).ListItems(i).Checked = False Next End If If chkStrang(Index).Enabled = True Then ' gesamtZeit aktualisieren UpdateZeitenTotal Index End If UpdateGesZeit ' vermerken, dass Änderungen gemacht worden sind AenderungenWurdenGemacht End Sub Private Sub UpdateGesZeit() Dim i As Integer m_lngSekundenTotal = 0 'Für alle Stränge For i = 0 To frameStrang.Count - 1 ' Zeiten der Prüfpunkte eines Stranges zusammenzählen UpdateZeitenTotal i Next ' Gesamtzeit anzeigen lblZeitTotal.Caption = "Dauer ges: " & Format((m_lngSekundenTotal / 60 / 60 / 24), "hh:mm") End Sub Private Sub cmbPruefstationNr_Change() ' eine andere Prüfstation wurde ausgewählt cmbPruefstationNr_Click End Sub Private Sub cmbPruefstationNr_Click() If cmbPruefstationNr.Enabled = False Then Exit Sub ' eine andere Prüfstation wurde ausgewählt m_lngPruefstationNr = Val(cmbPruefstationNr.Text) ' Formular neu aufbauen Timer1.Interval = 1 Timer1.Enabled = True End Sub Private Sub cmdNeueinlesen_Click() ' Reset Button wurde geklickt: ' alle Listboxen der Nennweiten neu erzeugen/aktualiseren CreateListboxNennweiten False ' Originalzustand vermerken KeineAenderungenWurdenGemacht End Sub Private Sub cmdPruefstationAendern_Click() ' Prüfstationswahl freigeben cmbPruefstationNr.Enabled = True End Sub Private Sub cmdSchliessen_Click() If optPruefergruppe(1).value = True And g_blnVersuch = False Then If MsgBox("Möchten Sie jetzt von 'Produktion' in den Modus 'Versuch' umschalten?", vbYesNo Or vbDefaultButton1) = vbYes Then g_blnVersuch = True End If End If If optPruefergruppe(0).value = True And g_blnVersuch = True Then If MsgBox("Möchten Sie jetzt von 'Versuch' in den Modus 'Produktion' umschalten?", vbYesNo Or vbDefaultButton1) = vbYes Then g_blnVersuch = False End If End If ' nur wenn Ändernungen vorgenommen wurden If m_blnGeaendert Then ' Benutzer Fragen, ob diese Änderungen aus gespeichert werden sollen If MsgBox("Sie haben Änderungen vorgenommen! Möchten Sie die Änderungen jetzt speichern?", vbYesNo Or vbDefaultButton2, "Änderungen speichern?") = vbYes Then ' Speichern nachholen cmdSave_Click End If End If Unload Me End Sub Private Sub cmdSave_Click() ' Speichern-Button wurde geklickt ' Speichern-Button dekativieren (Feedback, damit nicht nochmal ohne Änderungen auf Speichern-Button geklickt wird) cmdSave.Enabled = False Me.MousePointer = vbHourglass ' alles speichern speichern LogIntoDB "Prüfer ändert Referenzzähler Prüfpunkte Ausführen für P" & m_lngPruefstationNr, "Referenzzaehlerpp" ' alle Listboxen der Nennweiten aktualisieren (controls nicht neu laden) CreateListboxNennweiten False ' keine Änderungen zum speichern KeineAenderungenWurdenGemacht Me.MousePointer = vbNormal StatusBar1.SimpleText = "Änderungen wurden gespeichert" End Sub Private Sub Form_Activate() Screen.MousePointer = vbHourglass ' alle Listboxen der Nennweiten laden und aktualisieren CreateListboxNennweiten True KeineAenderungenWurdenGemacht m_bActivated = True Screen.MousePointer = vbNormal End Sub Private Sub Form_Load() m_bActivated = False m_lngPruefstationNr = g_App.PruefstationNr FillComboPruefstationen m_lngPruefstationNr If g_blnVersuch Or g_App.Mitarbeiter.GetPruefstellenleiter Then cmbPruefstationNr.Enabled = True cmdPruefstationAendern.Enabled = False Else cmbPruefstationNr.Enabled = False cmdPruefstationAendern.Enabled = True End If ' Listbox Header festlegen Call LstviewPruefpunkte(0).ColumnHeaders.Add(, , "Q [m³/h]") Call LstviewPruefpunkte(0).ColumnHeaders.Add(, , "t [s]") Call LstviewPruefpunkte(0).ColumnHeaders.Add(, , "Vol [m³]") optPruefergruppe(0).Tag = CONST_Produktion optPruefergruppe(0).Enabled = False optPruefergruppe(1).Tag = CONST_Versuch optPruefergruppe(1).Enabled = False If g_blnVersuch Then ' Versuch darf nur Versuch-Prüfpunkte ändern optPruefergruppe(1).value = True optPruefergruppe(1).Enabled = True Else ' Produktion darf nur Produktion-Prüfpunkte ändern optPruefergruppe(0).value = True optPruefergruppe(0).Enabled = True End If ' Pruefstellenleiter darf Versuch UND Produktion ändern If g_App.Mitarbeiter.GetPruefstellenleiter = True Then optPruefergruppe(0).Enabled = True optPruefergruppe(1).Enabled = True End If ' Ändernungen Versuch/Produktion-Modus anzeigen optPruefergruppe_Click 0 ' alles auf Anfang KeineAenderungenWurdenGemacht End Sub Private Sub FillComboPruefstationen(PruefstationNr As Long) Dim rs As CRecordset Dim strSQL As String Dim LngListindex As Long ' Alle Prüfstationen, die referenzzählerprüfpunkte haben strSQL = "SELECT distinct [PruefstationNr] From [Referenzzaehler] inner join ReferenzzaehlerPruefpunkt on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr order by PruefstationNr" Debug.Print strSQL Set rs = New CRecordset rs.openRS strSQL, True Do While Not rs.EOF cmbPruefstationNr.AddItem rs.getLongValue("PruefstationNr") If rs.getLongValue("PruefstationNr") = PruefstationNr Then LngListindex = cmbPruefstationNr.ListCount - 1 End If rs.MoveNext Loop cmbPruefstationNr.Enabled = False cmbPruefstationNr.ListIndex = LngListindex cmbPruefstationNr.Enabled = True End Sub Private Sub FillListboxNennweite(intIndex As Integer, lngNennweite As Long) Dim rs As CRecordset Dim strSQL As String Dim i As Integer Dim intCountPPchecked As Integer Dim intCountPP As Integer Dim lngZeitSumme As Long Dim lngSerienNr As Long LstviewPruefpunkte(intIndex).ListItems.Clear ' Der Versuch darf einzelne Prüfpunkte ändern ' Die Produktion darf KEINE einzelne Prüfpunkte ändern LstviewPruefpunkte(intIndex).Enabled = Not m_blnProduktion If m_blnProduktion Then strSQL = "select distinct Durchfluss, Pruefzeit , Ausfuehren from ReferenzzaehlerPruefpunkt inner join Referenzzaehler on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr " strSQL = strSQL & " Where Referenzzaehler.PruefstationNr = " & m_lngPruefstationNr & " and Nennweite = " & lngNennweite ' Produktion: nur die Pflichtprüfpunkte der Produktion anzeigen und auch die, die auf "ausführen" gestellt sind strSQL = strSQL & " and (PflichtPruefpunkt = 1 or Ausfuehren=1)" strSQL = strSQL & "order by Durchfluss desc" Else strSQL = "select distinct Durchfluss, Pruefzeit , Ausfuehren_Versuch from ReferenzzaehlerPruefpunkt inner join Referenzzaehler on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr " strSQL = strSQL & " Where Referenzzaehler.PruefstationNr = " & m_lngPruefstationNr & " and Nennweite = " & lngNennweite strSQL = strSQL & "order by Durchfluss desc" End If Set rs = New CRecordset Debug.Print strSQL rs.openRS strSQL, True i = 0 intCountPP = 0 intCountPPchecked = 0 Dim mylistitem As ListItem Do While Not rs.EOF Set mylistitem = LstviewPruefpunkte(intIndex).ListItems.Add(, , Round(rs.getDoubleValue("Durchfluss"), 5)) mylistitem.ListSubItems.Add , , rs.getDoubleValue("Pruefzeit") mylistitem.ListSubItems.Add , , Round(rs.getDoubleValue("Durchfluss") * rs.getDoubleValue("Pruefzeit") / 3600, 4) 'lngSerienNr = rs.getLongValue("SerienNr") i = LstviewPruefpunkte(intIndex).ListItems.Count intCountPP = intCountPP + 1 If m_blnProduktion Then ' Produktion If rs.getBooleanValue("Ausfuehren") = True Then ' Häkchen setzen, wenn Ausfuehren=1 intCountPPchecked = intCountPPchecked + 1 LstviewPruefpunkte(intIndex).Tag = "locked" LstviewPruefpunkte(intIndex).ListItems(i).Checked = True LstviewPruefpunkte(intIndex).Tag = "" lngZeitSumme = lngZeitSumme + rs.getDoubleValue("Pruefzeit") ' Produktion: End If Else ' Versuch If rs.getBooleanValue("Ausfuehren_Versuch") = True Then lngZeitSumme = lngZeitSumme + rs.getDoubleValue("Pruefzeit") LstviewPruefpunkte(intIndex).Tag = "locked" LstviewPruefpunkte(intIndex).ListItems(i).Checked = True LstviewPruefpunkte(intIndex).Tag = "" End If End If rs.MoveNext Loop If m_blnProduktion Then If intCountPPchecked = intCountPP And intCountPP > 0 Then ' für Produktion: Haken bei "alle aus/abwählen" setzen, wenn alle Pruefpunkt "ausgeführt" stehen chkStrang(intIndex).Enabled = False chkStrang(intIndex).value = vbChecked chkStrang(intIndex).Enabled = True Else chkStrang(intIndex).Enabled = False chkStrang(intIndex).value = vbUnchecked chkStrang(intIndex).Enabled = True End If End If LstviewPruefpunkte(intIndex).ColumnHeaders(1).Width = 900 LstviewPruefpunkte(intIndex).ColumnHeaders(2).Width = 555 LstviewPruefpunkte(intIndex).ColumnHeaders(3).Width = 1440 UpdateZeitenTotal intIndex End Sub Private Sub UpdateZeitenTotal(intIndex As Integer) Dim AnzahlPP As Integer Dim i As Integer Dim lngSekundenTotal As Long Dim lngZeitSumme As Long Dim lngCountProStrang As Long AnzahlPP = LstviewPruefpunkte(intIndex).ListItems.Count lngSekundenTotal = 0 For i = 1 To AnzahlPP 'Debug.Print LstviewPruefpunkte(intIndex).ListItems(i).ListSubItems(1).text If LstviewPruefpunkte(intIndex).ListItems(i).Checked = True Then lngCountProStrang = lngCountProStrang + 1 lngSekundenTotal = lngSekundenTotal + Val(LstviewPruefpunkte(intIndex).ListItems(i).ListSubItems(1).Text) End If Next m_lngSekundenTotal = m_lngSekundenTotal + lngSekundenTotal lblRZInfo(intIndex).Caption = "Dauer " & Format(lngSekundenTotal / 60 / 60 / 24, "hh:mm") & vbCrLf Dim lngDatum As Date lngDatum = getLetztePruefungDesStrangesDatum(m_lngPruefstationNr, Val(lblNennweite(intIndex))) If lngDatum <> 0 Then lblRZInfo(intIndex).Caption = lblRZInfo(intIndex).Caption & "letzte Prf vor " & Round(Now - lngDatum, 0) & " Tagen" End If If lngCountProStrang > 10 Then lblRZInfo(intIndex).Caption = "zuviele (11) Prüfpunkte angewählt! 10 sind möglich." lblRZInfo(intIndex).BackColor = RGB(255, 128, 128) Sleep 500, True lblRZInfo(intIndex).BackColor = &H8000000F Sleep 500, True lblRZInfo(intIndex).BackColor = RGB(255, 128, 128) Else lblRZInfo(intIndex).BackColor = &H8000000F End If End Sub Private Function getLetztePruefungDesStrangesDatum(lngPruefstationNr As Long, intNennweite As Integer) As Date Dim strSQL As String Dim rs As CRecordset strSQL = "SELECT TOP 1 Referenzzaehler.PruefstationNr, ReferenzzaehlerFehler.Datum, Referenzzaehler.Nennweite FROM ReferenzzaehlerFehler " strSQL = strSQL & " INNER JOIN Referenzzaehler ON ReferenzzaehlerFehler.SerienNr = Referenzzaehler.SerienNr " strSQL = strSQL & " Where (Referenzzaehler.PruefstationNr = " & lngPruefstationNr & ") And (Referenzzaehler.Nennweite = " & intNennweite & ") ORDER BY ReferenzzaehlerFehler.Datum DESC;" Set rs = New CRecordset rs.openRS strSQL, True If Not rs.EOF Then getLetztePruefungDesStrangesDatum = rs.getDateValue("Datum") End If End Function Private Sub UnloadControls() Dim intIndex As Integer For intIndex = 1 To frameStrang.Count - 1 Unload LstviewPruefpunkte(intIndex) Unload chkStrang(intIndex) Unload lblNennweite(intIndex) Unload lblRZInfo(intIndex) Unload frameStrang(intIndex) Next End Sub Private Sub CreateListboxNennweiten(blnLoadControls As Boolean) Dim rs As CRecordset Dim strSQL As String Dim lngNennweite As Long Dim intIndex As Integer Dim intAnzahl As Integer KeineAenderungenWurdenGemacht ' alle vorhandenen Nennweiten ermitteln strSQL = "select distinct Nennweite from Referenzzaehler inner join ReferenzzaehlerPruefpunkt on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr where Referenzzaehler.PruefstationNr = " & m_lngPruefstationNr & " order by Nennweite " Debug.Print strSQL Set rs = New CRecordset rs.openRS strSQL intAnzahl = rs.RecordCount intIndex = 0 Do While Not rs.EOF lngNennweite = rs.getLongValue("Nennweite") If blnLoadControls Then ' erste Listview If intIndex = 0 Then lblNennweite(0).Caption = CStr(lngNennweite) frameStrang(0).Left = (Me.ScaleWidth / (intAnzahl + 1)) * 0.5 frameStrang(0).Width = Me.ScaleWidth / (intAnzahl + 1) frameStrang(0).Visible = True lblRZInfo(0).Caption = "" Else On Error Resume Next load frameStrang(intIndex) frameStrang(intIndex).Visible = True frameStrang(intIndex).Width = Me.ScaleWidth / (intAnzahl + 1) frameStrang(intIndex).Left = frameStrang(intIndex - 1).Left + frameStrang(intIndex - 1).Width + 100 load LstviewPruefpunkte(intIndex) Set LstviewPruefpunkte(intIndex).Container = frameStrang(intIndex) LstviewPruefpunkte(intIndex).Visible = True load lblNennweite(intIndex) Set lblNennweite(intIndex).Container = frameStrang(intIndex) lblNennweite(intIndex).Caption = CStr(lngNennweite) lblNennweite(intIndex).Visible = True load chkStrang(intIndex) chkStrang(intIndex).Enabled = False chkStrang(intIndex).value = vbUnchecked chkStrang(intIndex).Enabled = True Set chkStrang(intIndex).Container = frameStrang(intIndex) chkStrang(intIndex).Visible = True load lblRZInfo(intIndex) Set lblRZInfo(intIndex).Container = frameStrang(intIndex) lblRZInfo(intIndex).Caption = "" lblRZInfo(intIndex).Visible = True End If End If LstviewPruefpunkte(intIndex).Width = frameStrang(intIndex).Width - LstviewPruefpunkte(intIndex).Left * 2 FillListboxNennweite intIndex, lngNennweite intIndex = intIndex + 1 rs.MoveNext Loop UpdateGesZeit End Sub Private Sub LstviewPruefpunkte_Click(Index As Integer) If LstviewPruefpunkte(Index).Tag <> "locked" Then AenderungenWurdenGemacht UpdateZeitenTotal Index UpdateGesZeit End If End Sub Private Sub optPruefergruppe_Click(Index As Integer) If optPruefergruppe(Index).Enabled = False Then Exit Sub If optPruefergruppe(0).value = True Then m_blnProduktion = True Else m_blnProduktion = False End If lblUeberschrift.Caption = "Prüfpunkte der Referenzzählerprüfung für '" & IIf(m_blnProduktion, "Produktion", "Versuch") & "'" If m_bActivated Then ' erst wenn das Formular aktiviert wurde, die Listboxen aktualisieren (nicht neu laden) CreateListboxNennweiten False End If End Sub Private Sub speichern() ' speichert die Änderungen Dim Strang As Integer Dim PPNr As Integer Dim AnzahlProStrang As Integer Dim dblQ As Double Dim strSQL As String Dim Nennweite As Integer Dim lngSerienNrRZ As Long Dim lngRecordsaffected As Long Dim rs As CRecordset '''''''''' ' Anzahl der angewählten Prüfpunkte pro Strang zählen For Strang = 0 To LstviewPruefpunkte.Count - 1 AnzahlProStrang = 0 For PPNr = 1 To LstviewPruefpunkte(Strang).ListItems.Count If LstviewPruefpunkte(Strang).ListItems(PPNr).Checked = True Then AnzahlProStrang = AnzahlProStrang + 1 End If Next If m_blnProduktion Then If AnzahlProStrang = 1 Then MsgBox "WARNUNG: Bei einem Prüfpunkt pro Strang kann später nicht interpoliert werden!" End If End If Next '''''''''' ' für alle Stränge For Strang = 0 To LstviewPruefpunkte.Count - 1 Nennweite = lblNennweite(Strang) If m_blnProduktion Then ' Produktion: zuerst alle betroffenen Pruefpunkte zurücksetzen: NICHT ausführen strSQL = "update ReferenzzaehlerPruefpunkt set Ausfuehren = 0 where Herkunft like '" & m_lngPruefstationNr & "-" & Format(Nennweite, "000") & "%'" g_App.getDB.getConnection.Execute strSQL, lngRecordsaffected Debug.Print strSQL & " ===>" & lngRecordsaffected & " zurückgesetzt" If chkStrang(Strang).value = vbChecked Then strSQL = "update ReferenzzaehlerPruefpunkt set Ausfuehren = Pflichtpruefpunkt where Herkunft like '" & m_lngPruefstationNr & "-" & Format(Nennweite, "000") & "-%'" g_App.getDB.getConnection.Execute strSQL, lngRecordsaffected & " wie Pflichtpruefpunkt gesetzt" Debug.Print strSQL & " ===>" & lngRecordsaffected End If Else ' Versuch ' für alle Prüfpunkte des Stranges For PPNr = 1 To LstviewPruefpunkte(Strang).ListItems.Count ' alle Durchflüsse gesondert betrachten dblQ = LstviewPruefpunkte(Strang).ListItems(PPNr).Text strSQL = "select * from ReferenzzaehlerPruefpunkt where Herkunft like '" & m_lngPruefstationNr & "-" & Format(Nennweite, "000") & "-%' and cast(Durchfluss as decimal(18,5)) = cast(" & Replace(dblQ, ",", ".") & " as decimal(18,5)) " Set rs = New CRecordset rs.openRS strSQL, False Debug.Print strSQL If rs.EOF Then MsgBox ("Es gibt keinen Datensatz für Abfrage " & vbCrLf & strSQL) Else ' Das Auführen des Versuchs-Prüfpunkt ein/ausschalten Do While Not rs.EOF rs.setValue "Ausfuehren_Versuch", LstviewPruefpunkte(Strang).ListItems(PPNr).Checked rs.update rs.MoveNext Loop End If Next End If Next End Sub Private Sub AenderungenWurdenGemacht() ' Es wurden Änderungen gemacht, also z.B. den Save-Button aktivieren cmdSave.Enabled = True m_blnGeaendert = True StatusBar1.SimpleText = "ungespeicherte Änderungen" End Sub Private Sub KeineAenderungenWurdenGemacht() ' Es wurden Änderungen gespeichert oder rückgängig gemacht, also z.B. den Save-Button deaktivieren cmdSave.Enabled = False m_blnGeaendert = False StatusBar1.SimpleText = "keine Änderungen" End Sub Private Sub Timer1_Timer() Timer1.Enabled = False ' Listboxen der Nennweiten entfernen UnloadControls ' alle Listboxen der Nennweiten neu erzeugen CreateListboxNennweiten True ' Originalzustand vermerken KeineAenderungenWurdenGemacht End Sub ' 'Private Sub Reparieren() ' Dim strSQL As String ' Dim rs As CRecordset ' ' strSQL = "select ReferenzzaehlerPruefpunkt.id, Referenzzaehler.PruefstationNr, Referenzzaehler.Nennweite, Referenzzaehler.MIDGruppe, ReferenzzaehlerPruefpunkt.SerienNr, Durchfluss, Herkunft from ReferenzzaehlerPruefpunkt inner join Referenzzaehler on ReferenzzaehlerPruefpunkt.SerienNr = Referenzzaehler.SerienNr " ' ' Debug.Print strSQL ' ' Set rs = New CRecordset ' rs.openRS strSQL ' ' ' Do While Not rs.EOF ' If rs.getStringValue("Herkunft") <> Format(rs.getLongValue("PruefstationNr"), "0000") & "-" & Format(rs.getLongValue("Nennweite"), "000") & "-" & rs.getStringValue("MidGruppe") Then ' ' strSQL = "UPDATE ReferenzzaehlerPruefpunkt set Herkunft = '" & Format(rs.getLongValue("PruefstationNr"), "0000") & "-" & Format(rs.getLongValue("Nennweite"), "000") & "-" & rs.getStringValue("MidGruppe") & "' where ID= " & rs.getLongValue("ID") ' Debug.Print strSQL ' ' End If ' rs.MoveNext ' Loop ' 'End Sub