VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX" Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx" Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL" Begin VB.Form frmManuellDetails ClientHeight = 9510 ClientLeft = 60 ClientTop = 345 ClientWidth = 18030 LinkTopic = "Form1" ScaleHeight = 9510 ScaleWidth = 18030 StartUpPosition = 3 'Windows-Standard WindowState = 2 'Maximiert Begin VB.Frame frameERegister Caption = "eRegister" Height = 1395 Left = 60 TabIndex = 50 Top = 5820 Width = 1515 Begin VB.ComboBox cmbeRegisterPP Height = 315 Left = 480 Style = 2 'Dropdown-Liste TabIndex = 52 Top = 900 Width = 795 End Begin VB.CommandButton cmdeRegisterpruefpunkt Caption = "Messung" Height = 375 Left = 180 TabIndex = 51 Top = 300 Width = 1215 End Begin VB.Label Label4 Caption = "PP" Height = 255 Left = 60 TabIndex = 53 Top = 960 Width = 375 End End Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 Height = 1395 Left = 690 TabIndex = 49 Top = 7950 Visible = 0 'False Width = 6435 _ExtentX = 11351 _ExtentY = 2461 _Version = 393216 End Begin VB.TextBox txtInfoVerbundzaehler Alignment = 2 'Zentriert BackColor = &H00C0FFFF& Height = 1485 Left = 1740 MultiLine = -1 'True TabIndex = 47 Text = "frmManuellDetails.frx":0000 Top = 7950 Width = 6315 End Begin VB.TextBox txtWasserVorlaufTemperatur Alignment = 1 'Rechts Height = 345 Left = 240 TabIndex = 43 Top = 5370 Width = 735 End Begin VB.CommandButton cmdRuecklaeuferanalyse Caption = "Rückläufer" Height = 255 Left = 240 TabIndex = 41 Top = 4530 Width = 1155 End Begin VB.Frame Frame1 Caption = "PrüfgangNr" Height = 495 Left = 120 TabIndex = 38 Top = 3960 Width = 1395 Begin VB.Label lblPruefgangNr Height = 195 Left = 60 TabIndex = 39 Top = 240 Width = 1275 End End Begin VB.Frame frameTab BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 6495 Index = 0 Left = 1800 TabIndex = 10 Top = 780 Width = 14565 Begin VB.CommandButton cmdNZInfo Caption = "NZ Prüfergebnisse aus LU anzeigen" Height = 525 Index = 0 Left = 120 TabIndex = 48 Top = 3660 Width = 1575 End Begin VB.TextBox txtFabNr Alignment = 1 'Rechts Height = 285 Index = 0 Left = 120 TabIndex = 0 Top = 1710 Width = 1485 End Begin VB.CheckBox chkPruefNZ Alignment = 1 'Rechts ausgerichtet Caption = "Prüfnebenzähler" Height = 255 Index = 0 Left = 240 TabIndex = 2 Top = 2925 Width = 1455 End Begin VB.TextBox txtSerienNrNZ Alignment = 1 'Rechts Height = 285 Index = 0 Left = 150 TabIndex = 1 ToolTipText = "Um die NZ Seriennummer ändern zu können, klicken Sie doppelt in dieses Feld" Top = 2625 Width = 1575 End Begin VB.TextBox txtQ Alignment = 1 'Rechts BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 0 Left = 3000 TabIndex = 3 Top = 540 Width = 1035 End Begin VB.TextBox txtBehVol Alignment = 1 'Rechts BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3000 TabIndex = 8 Top = 4440 Width = 1035 End Begin VB.TextBox txtNZStop Alignment = 1 'Rechts BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 390 Index = 0 Left = 3000 TabIndex = 7 Top = 2940 Width = 1035 End Begin VB.TextBox txtNZStart Alignment = 1 'Rechts BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3000 TabIndex = 6 Top = 2520 Width = 1035 End Begin VB.TextBox txtHZStop Alignment = 1 'Rechts BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Index = 0 Left = 3000 TabIndex = 5 Top = 1440 Width = 1035 End Begin VB.TextBox txtHZStart Alignment = 1 'Rechts BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 0 Left = 3000 TabIndex = 4 Top = 1020 Width = 1035 End Begin MSForms.ComboBox cmb2KundeneigeneSNr Height = 315 Index = 0 Left = 120 TabIndex = 46 Top = 4860 Width = 2325 VariousPropertyBits= 746604571 DisplayStyle = 3 Size = "4101;556" MatchEntry = 1 ShowDropButtonWhen= 2 FontHeight = 165 FontCharSet = 0 FontPitchAndFamily= 2 End Begin VB.Label lblFabNr Caption = "FabNr:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Index = 0 Left = 150 TabIndex = 42 Top = 1440 Width = 1455 End Begin VB.Label LabelKndEigeneSerNr Caption = "Kundeneigene SerNr NZ:" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Index = 0 Left = 150 TabIndex = 40 Top = 4380 Width = 1545 End Begin VB.Label lblFGo Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 3240 TabIndex = 37 Top = 5880 Width = 795 End Begin VB.Label lblFGu Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 3240 TabIndex = 35 Top = 5040 Width = 795 End Begin VB.Label Label1 Caption = "FG+" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 16 Left = 2400 TabIndex = 30 Top = 5880 Width = 495 End Begin VB.Label Label1 Caption = "FG-" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 15 Left = 2520 TabIndex = 29 Top = 5040 Width = 495 End Begin VB.Label Label1 Caption = "Prüfpunkt" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 14 Left = 2040 TabIndex = 26 Top = 240 Width = 1095 End Begin VB.Line Line1 Index = 3 Visible = 0 'False X1 = 11040 X2 = 11040 Y1 = 480 Y2 = 6120 End Begin VB.Line Line1 Index = 2 Visible = 0 'False X1 = 1950 X2 = 12840 Y1 = 3840 Y2 = 3840 End Begin VB.Line Line1 Index = 1 Visible = 0 'False X1 = 2040 X2 = 12840 Y1 = 2280 Y2 = 2280 End Begin VB.Line Line1 Index = 0 Visible = 0 'False X1 = 2040 X2 = 12840 Y1 = 960 Y2 = 960 End Begin VB.Label lblNr Alignment = 2 'Zentriert Caption = "1" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 3060 TabIndex = 25 Top = 240 Width = 975 End Begin VB.Label Label1 Caption = "Fehler in %" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 13 Left = 1800 TabIndex = 24 Top = 5520 Width = 1215 End Begin VB.Label Label1 Caption = "Beh.Vol" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 12 Left = 2040 TabIndex = 23 Top = 4560 Width = 855 End Begin VB.Label Label1 Caption = "Zähl Vol" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 11 Left = 2040 TabIndex = 22 Top = 4080 Width = 855 End Begin VB.Label Label1 Caption = "NZ Vol" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 10 Left = 2040 TabIndex = 21 Top = 3480 Width = 855 End Begin VB.Label Label1 Caption = "NZ Stop" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 9 Left = 2040 TabIndex = 20 Top = 2880 Width = 1335 End Begin VB.Label Label1 Caption = "NZ Start" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 8 Left = 2040 TabIndex = 19 Top = 2520 Width = 855 End Begin VB.Label Label1 Caption = "HZ Vol" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 7 Left = 2040 TabIndex = 18 Top = 1920 Width = 855 End Begin VB.Label Label1 Caption = "HZ Stop" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 6 Left = 2040 TabIndex = 17 Top = 1440 Width = 855 End Begin VB.Label Label1 Caption = "HZ Start" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 5 Left = 2040 TabIndex = 16 Top = 1080 Width = 855 End Begin VB.Label Label1 Caption = "Q (m^3/h)" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 4 Left = 2040 TabIndex = 15 Top = 600 Width = 975 End Begin VB.Label Label1 Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach Caption = "Label1" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 765 Index = 2 Left = 90 TabIndex = 14 Top = 600 Width = 1815 End Begin VB.Label Label1 Caption = "Nebenzähler:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 150 TabIndex = 13 Top = 2370 Width = 1335 End Begin VB.Label Label1 Caption = "Hauptzähler:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 150 TabIndex = 12 Top = 300 Width = 1335 End Begin VB.Label lblVol Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3000 TabIndex = 34 Top = 3960 Width = 1035 End Begin VB.Label lblFehler Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3030 TabIndex = 36 Top = 5400 Width = 1035 End Begin VB.Label lblNZVol Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3000 TabIndex = 33 Top = 3360 Width = 1035 End Begin VB.Label lblHZVol Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3000 TabIndex = 32 Top = 1800 Width = 1035 End End Begin VB.CommandButton cmdCancel Caption = "Abbruch ohne speichern" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 10680 TabIndex = 28 Top = 8760 Width = 1935 End Begin VB.CommandButton cmdOK Caption = "Daten speichern" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 12900 TabIndex = 27 Top = 8760 Width = 1935 End Begin MSComctlLib.TabStrip TabStrip1 Height = 6975 Left = 1680 TabIndex = 11 Top = 300 Width = 14835 _ExtentX = 26167 _ExtentY = 12303 _Version = 393216 BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} NumTabs = 1 BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} ImageVarType = 2 EndProperty EndProperty End Begin VB.Label Label3 Caption = "°C" Height = 255 Left = 1050 TabIndex = 45 Top = 5460 Width = 495 End Begin VB.Label Label2 Caption = "Vorlauf Temperatur" Height = 435 Left = 270 TabIndex = 44 Top = 4980 Width = 1215 End Begin VB.Label Label1 Alignment = 1 'Rechts BorderStyle = 1 'Fest Einfach Caption = "ist nicht sichtbar, mus aber beleiben !!!" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1095 Index = 3 Left = 120 TabIndex = 31 Top = 2220 Visible = 0 'False Width = 1335 End Begin VB.Label LblAngaben Height = 375 Left = 240 TabIndex = 9 Top = 120 Width = 9255 End End Attribute VB_Name = "frmManuellDetails" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private m_nRet As Integer Public m_colEinbauplatz As Collection Public m_Pruefgang As CPruefgang Private AltSelectedTab As Integer Private m_Pruefzaehler As CPruefzaehler Private m_colUniquePP As Collection Public m_blnRueckwaertspruefung As Boolean Public m_blnSimpleInput As Boolean Public mblnOeffnenSchliessenErgaenzen As Boolean Public mbln_eRegister As Boolean Private m_AnzahlPP As Integer Private m_blnEingabeFehler As Boolean Private Type NZ_PRUEFDATEN_TYP SerienNrNebenzaehler As Long KundeneigeneSerienNrNZ As String Q1_Soll As Double Fehler_Q1 As Double Q2_Soll As Double Fehler_Q2 As Double MetrologNZ As String End Type ' @return Code, mit dem endDialog aufgerufen wurde ' Public Function getExitCode() As Integer getExitCode = m_nRet End Function '------------------------------------------------------------------------------ ' Private Funktionalität '------------------------------------------------------------------------------ ' Dialog beenden ' ' @param nRet Returncode des Dialogs ' Private Sub endDialog(nRet As Integer) m_nRet = nRet Unload Me End Sub Private Sub chkPruefNZ_GotFocus(Index As Integer) SetGotLostFocusColor chkPruefNZ(Index), True End Sub Private Sub chkPruefNZ_KeyPress(Index As Integer, KeyAscii As Integer) cmdOK.Enabled = True If KeyAscii = 13 Then If txtQ(Index * 100).Enabled = True Then txtQ(Index * 100).SetFocus End If End If End Sub Private Sub chkPruefNZ_LostFocus(Index As Integer) SetGotLostFocusColor chkPruefNZ(Index), False End Sub '------------------------------------------------------------------------------ ' Event-Handling '------------------------------------------------------------------------------ Private Sub cmdOk_Click() If txtWasserVorlaufTemperatur.text = "" Then MsgBox "Bitte Vorlauftemperatur eingeben!" txtWasserVorlaufTemperatur.SetFocus Exit Sub End If If ueberpruefe() = True Then Call PruefdatenSpeichern MsgBox ("Die Pruefergebnisse wurden gespeichert") Call endDialog(IDOK) End If End Sub Private Sub cmdCancel_Click() Call endDialog(IDCANCEL) End Sub Private Sub cmdRuecklaeuferanalyse_Click() Dim lngSerienNr As Long Dim Pruefzaehler As CPruefzaehler lngSerienNr = Val(TabStrip1.SelectedItem.Tag) Dim objForm As frmRuecklaeuferanalyse Set objForm = New frmRuecklaeuferanalyse objForm.m_EinbauplatzNr = 0 Set Pruefzaehler = New CPruefzaehler Pruefzaehler.loadForSerienNr lngSerienNr Set objForm.m_Pruefzaehler = Pruefzaehler objForm.Show vbModal, Me End Sub Private Sub Form_Activate() If txtWasserVorlaufTemperatur.Enabled = True Then If txtWasserVorlaufTemperatur.text = "" Then txtWasserVorlaufTemperatur.SetFocus End If End If ' If txtSerienNrNZ(TabStrip1.SelectedItem.Index - 1).Enabled And txtSerienNrNZ(TabStrip1.SelectedItem.Index - 1).Visible Then ' txtSerienNrNZ(TabStrip1.SelectedItem.Index - 1).SetFocus ' Else ' txtFabNr(TabStrip1.SelectedItem.Index - 1).SetFocus ' End If End Sub ''Private Sub cmdDruck_Click() '' Call modDruck.PruefgangDruck(m_Pruefgang, 20, m_colEinbauplatz, 0, "Manuelle Eingabe") ''End Sub Private Sub Form_Load() Dim frame_index As Integer Dim TextHZStart As TextBox Dim i As Integer Dim selectedTab As Integer Dim bGefunden As Boolean Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim PPNr As Integer Dim Pruefpunkte As CPruefpunkte If m_Pruefgang.PruefgangNr <> 0 Then lblPruefgangNr.caption = m_Pruefgang.PruefgangNr Else lblPruefgangNr.caption = "(neu)" End If Me.caption = "manuelle Eingabe der Zählerstände an der Prüfstation " & g_App.PruefstationNr For i = 0 To 9 If i > 0 Then ' TabStrip.tabs.item(1) existiert und FrameTab(0) ist bereits geladen ' deshalb erst ab TabStrip.item(2) addieren und ab FrameTab(1) laden ' neuen Tab erzeugen TabStrip1.Tabs.Add ' Neuen Frame erzeugen load frameTab(i) End If ' nach vorne frameTab(i).ZOrder frameTab(i).Visible = False frameTab(i).caption = "Einbauplatz " & i + 1 Set Einbauplatz = m_colEinbauplatz.Item(i + 1) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then ' TabStrip (1..6) initialisieren TabStrip1.Tabs.Item(i + 1).Tag = Pruefzaehler.getSerienNr If g_blnKundeneigeneSerienNrAnzeigen = False Then TabStrip1.Tabs.Item(i + 1).caption = FormatSerienNr(Pruefzaehler.getSerienNr) Else TabStrip1.Tabs.Item(i + 1).caption = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr End If m_AnzahlPP = Pruefzaehler.getPruefpunkte.getPruefpunkteCount ' TabFrame (0..9) initialisieren InitTabFrame i, Pruefzaehler.IstVerbundZaehler ' If bGefunden = False Then ' bGefunden = True ' ' Für ersten gefundenen Prüfzähler TabStrip-Tab auswählen ' selectedTab = i ' Call TabStrip_Auswaehlen(selectedTab) ' TabStrip1.Tabs.Item(selectedTab + 1).Selected = True ' End If End If next1: Next i For i = 0 To 9 Set Einbauplatz = m_colEinbauplatz.Item(i + 1) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then ' Pruefpunkt Daten eintragen Set Pruefpunkte = Pruefzaehler.getPruefpunkte m_AnzahlPP = Pruefpunkte.getPruefpunkteCount For PPNr = 1 To m_AnzahlPP txtQ(i * 100 + PPNr - 1).text = Pruefpunkte.getPruefpunkt(PPNr).getQ lblFGo(i * 100 + PPNr - 1).caption = Format(Pruefpunkte.getPruefpunkt(PPNr).getFGo, "0.0") lblFGu(i * 100 + PPNr - 1).caption = Format(Pruefpunkte.getPruefpunkt(PPNr).getFGu, "0.0") Next If Pruefzaehler.IstVerbundZaehler Then FillFehlergrenzenVerbundzaehler (i) End If For PPNr = 1 To 10 If m_blnSimpleInput Then txtHZStart(i * 100 + PPNr - 1).Enabled = False txtHZStart(i * 100 + PPNr - 1).BackColor = &H8000000F txtHZStop(i * 100 + PPNr - 1).Enabled = False txtHZStop(i * 100 + PPNr - 1).BackColor = &H8000000F txtNZStart(i * 100 + PPNr - 1).Enabled = False txtNZStart(i * 100 + PPNr - 1).BackColor = &H8000000F txtNZStop(i * 100 + PPNr - 1).Enabled = False txtNZStop(i * 100 + PPNr - 1).BackColor = &H8000000F txtBehVol(i * 100 + PPNr - 1).Enabled = False txtBehVol(i * 100 + PPNr - 1).BackColor = &H8000000F End If Next ' SerienNr eintragen If g_blnKundeneigeneSerienNrAnzeigen = True Then Label1(2 + i * 100).caption = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr & vbCrLf & "SensusSNr:" & vbCrLf & FormatSerienNr(Pruefzaehler.getSerienNr) Else Label1(2 + i * 100).caption = FormatSerienNr(Pruefzaehler.getSerienNr) If Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr <> "" Then Label1(2 + i * 100).caption = Label1(2 + i * 100).caption & vbCrLf & "KndEigene:" & vbCrLf & Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr End If End If Fillcmb2KundeneigeneSNr Pruefzaehler.getAuftragPosition.GetFertigungsauftragNr, i Dim lngSerienNrNebenzaehler As Long Dim strKndEigeneSerienNrNebenzaehler As String Dim blnIstPruefnebenzaehler As Boolean Dim dblPPOeffnen As Double Dim dblPPSchliessen As Double Dim dblPP_OeffnenFehler As Double Dim dblPP_SchliessenFehler As Double cmb2KundeneigeneSNr(i).Locked = False cmb2KundeneigeneSNr(i).Style = fmStyleDropDownCombo If GetNebenzaehlerDaten(m_Pruefgang.PruefgangNr, Pruefzaehler.getSerienNr, lngSerienNrNebenzaehler, strKndEigeneSerienNrNebenzaehler, blnIstPruefnebenzaehler, dblPPOeffnen, dblPPSchliessen, dblPP_OeffnenFehler, dblPP_SchliessenFehler) = 0 Then cmb2KundeneigeneSNr(i).text = strKndEigeneSerienNrNebenzaehler If lngSerienNrNebenzaehler > 0 Then txtSerienNrNZ(i).text = lngSerienNrNebenzaehler txtSerienNrNZ(i).Locked = True End If End If End If Next If m_Pruefgang.PruefgangNr <> 0 Then ' Prüfgang ist vorhanden, dann Prüffehler lesen und Eingabefelder mit Prüffehler vorbesetzen fillPrueffehler (m_Pruefgang.PruefgangNr) End If For i = 0 To 9 Set Einbauplatz = m_colEinbauplatz.Item(i + 1) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If bGefunden = False Then bGefunden = True ' Für ersten gefundenen Prüfzähler TabStrip-Tab auswählen selectedTab = i Call TabStrip_Auswaehlen(selectedTab) TabStrip1.Tabs.Item(selectedTab + 1).Selected = True End If End If Next ' eRegister frameERegister.Visible = False mbln_eRegister = False For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then If Not Einbauplatz.eRegister Is Nothing Then frameERegister.Visible = True mbln_eRegister = True cmbeRegisterPP.Clear cmbeRegisterPP.AddItem 1 cmbeRegisterPP.AddItem 2 cmbeRegisterPP.AddItem 3 ' Voreinstellung Prüfpunkt 1 cmbeRegisterPP.ListIndex = 0 End If End If Next End Sub Private Sub InitTabFrame(frame_index As Integer, IstVerbundZaehler As Boolean) ' frame_index fängt mit 0 an Dim i As Integer 'Dim Index As Integer Dim xPos As Long Dim newIndex As Integer Dim istart As Integer Dim TabIndex As Integer '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Position des Rahmens festlegen frameTab(frame_index).Top = frameTab(0).Top frameTab(frame_index).Left = frameTab(0).Left frameTab(frame_index).Width = frameTab(0).Width frameTab(frame_index).Height = frameTab(0).Height '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' neue Controls laden (kopieren) und Eigenschaften setzen ' Im ersten Tab (frame_index=0) sind schon Controls mit Index=0 vorhanden istart = IIf(frame_index = 0, 1, 0) If frame_index > 0 Then load txtSerienNrNZ(frame_index) 'load txtKundeneigeneSerienNrNZ(frame_index) load cmb2KundeneigeneSNr(frame_index) load chkPruefNZ(frame_index) load LabelKndEigeneSerNr(frame_index) load lblFabNr(frame_index) load txtFabNr(frame_index) load cmdNZInfo(frame_index) End If For i = istart To 9 newIndex = frame_index * 100 + i load lblNr(newIndex) load txtQ(newIndex) load txtHZStart(newIndex) load txtHZStop(newIndex) load txtNZStart(newIndex) load txtNZStop(newIndex) load txtBehVol(newIndex) load lblHZVol(newIndex) load lblNZVol(newIndex) load lblVol(newIndex) load lblFehler(newIndex) load lblFGo(newIndex) load lblFGu(newIndex) xPos = lblNr(0).Left + (IIf(i > 8, 0, 10) + Screen.TwipsPerPixelX * 10 + lblNr(0).Width) * i With lblNr(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .caption = i + 1 .Visible = True If IstVerbundZaehler Then If i = 8 Then .caption = "Öffn." If i = 9 Then .caption = "Schl." End If End With With txtQ(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With txtHZStart(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With txtHZStop(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With txtNZStart(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With txtNZStop(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblHZVol(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblNZVol(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblNZVol(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblNZVol(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With txtBehVol(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblVol(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblFehler(newIndex) Set .Container = frameTab(frame_index) .Left = xPos .Visible = True End With With lblFGo(newIndex) Set .Container = frameTab(frame_index) .Left = lblFGo(0).Left + (IIf(i > 8, 0, 10) + Screen.TwipsPerPixelX * 10 + lblNr(0).Width) * i .Visible = True End With With lblFGu(newIndex) Set .Container = frameTab(frame_index) .Left = lblFGu(0).Left + (IIf(i > 8, 0, 10) + Screen.TwipsPerPixelX * 10 + lblNr(0).Width) * i .Visible = True End With Next ' im nullten Frame_index sind schon alle Labels und Linien vorhanden If frame_index > 0 Then For i = 0 To 14 newIndex = frame_index * 100 + i load Label1(newIndex) With Label1(newIndex) Set .Container = frameTab(frame_index) .Alignment = Label1(i).Alignment .Visible = True .Move Label1(i).Left, Label1(i).Top, Label1(i).Width, Label1(i).Height .caption = Label1(i).caption .Font = Label1(i).Font .FontBold = Label1(i).FontBold .FontSize = Label1(i).FontSize .BorderStyle = Label1(i).BorderStyle End With Next ' Linien setzen For i = 0 To 3 newIndex = frame_index * 100 + i load Line1(newIndex) With Line1(newIndex) Set .Container = frameTab(frame_index) If i = 3 And Not IstVerbundZaehler Then .Visible = False Else .Visible = True End If .x1 = Line1(i).x1 .x2 = Line1(i).x2 .y1 = Line1(i).y1 .y2 = Line1(i).y2 End With Next End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Not IstVerbundZaehler Then For i = 0 To 9 newIndex = (frame_index) * 100 + i txtNZStart.Item(newIndex).Visible = False txtNZStop.Item(newIndex).Visible = False lblNZVol.Item(newIndex).Visible = False Next i Label1(8 + (frame_index) * 100).Visible = False Label1(9 + (frame_index) * 100).Visible = False Label1(10 + (frame_index) * 100).Visible = False Label1(1 + (frame_index) * 100).Visible = False Line1(3 + (frame_index) * 100).Visible = False txtSerienNrNZ(frame_index).Visible = False cmdNZInfo(frame_index).Visible = False LabelKndEigeneSerNr(frame_index).Visible = False 'txtKundeneigeneSerienNrNZ(frame_index).Visible = False cmb2KundeneigeneSNr(frame_index).Visible = False chkPruefNZ(frame_index).Visible = False txtInfoVerbundzaehler.Visible = False Else ' Verbundzähler If frame_index > 0 Then Set cmdNZInfo(frame_index).Container = frameTab(frame_index) Set txtSerienNrNZ(frame_index).Container = frameTab(frame_index) 'Set txtKundeneigeneSerienNrNZ(frame_index).Container = frameTab(frame_index) Set cmb2KundeneigeneSNr(frame_index).Container = frameTab(frame_index) Set chkPruefNZ(frame_index).Container = frameTab(frame_index) Set LabelKndEigeneSerNr(frame_index).Container = frameTab(frame_index) End If 'txtKundeneigeneSerienNrNZ(frame_index).Visible = True cmb2KundeneigeneSNr(frame_index).Visible = True txtSerienNrNZ(frame_index).Visible = True chkPruefNZ(frame_index).Visible = True LabelKndEigeneSerNr(frame_index).Visible = True cmdNZInfo(frame_index).Visible = True txtInfoVerbundzaehler.Visible = True End If Set lblFabNr(frame_index).Container = frameTab(frame_index) lblFabNr(frame_index).Visible = True Set txtFabNr(frame_index).Container = frameTab(frame_index) txtFabNr(frame_index).Visible = True ' Alle Zähler: Label1(3 + (frame_index) * 100).Visible = False If m_blnSimpleInput Then For i = istart To 10 If (Not IstVerbundZaehler And i > m_AnzahlPP) Or (IstVerbundZaehler And i > m_AnzahlPP And i < 9) Then txtQ(frame_index * 100 + i - 1).Visible = False txtHZStart(frame_index * 100 + i - 1).Visible = False txtHZStop(frame_index * 100 + i - 1).Visible = False lblHZVol(frame_index * 100 + i - 1).Visible = False txtNZStart(frame_index * 100 + i - 1).Visible = False txtNZStop(frame_index * 100 + i - 1).Visible = False lblNZVol(frame_index * 100 + i - 1).Visible = False lblVol(frame_index * 100 + i - 1).Visible = False txtBehVol(frame_index * 100 + i - 1).Visible = False lblFGu(frame_index * 100 + i - 1).Visible = False lblFehler(frame_index * 100 + i - 1).Visible = False lblFGo(frame_index * 100 + i - 1).Visible = False lblNr(frame_index * 100 + i - 1).Visible = False End If Next End If End Sub Private Sub Label1_Click(Index As Integer) MsgBox "Ändern" End Sub Private Sub lblFehler_DblClick(Index As Integer) Dim sNeuerWert As String sNeuerWert = InputBox("Bitte geben Sie den Fehler in % ein!") If sNeuerWert = "" Or Not IsNumeric(sNeuerWert) Then ' Eingabe abgebrochen Exit Sub End If sNeuerWert = stringToDouble(Format(sNeuerWert, "0.0")) sNeuerWert = Replace(sNeuerWert, ".", ",") If IsNumeric(sNeuerWert) Then 'Wert OK lblFehler(Index).caption = sNeuerWert lblFehler(Index).Tag = "Handeingabe" txtBehVol(Index).text = "" txtHZStart(Index).text = "" txtHZStop(Index).text = "" txtNZStart(Index).text = "" txtNZStop(Index).text = "" lblHZVol(Index).caption = "" lblNZVol(Index).caption = "" lblVol(Index).caption = "" checkToleranz (Index) Else ' Falsche Eingabe lblFehler(Index).caption = "" checkToleranz (Index) End If End Sub Private Sub TabStrip1_Click() Dim selected_tab As Integer ' selected_tab im Bereich von 0 bis 9 selected_tab = TabStrip1.SelectedItem.Index - 1 ' Wenn der Ausgewählte Tab immernoch gleich AltSelectedTab ' wie beim letzten Mal, dann nichts tun If selected_tab = AltSelectedTab Then Exit Sub TabStrip_Auswaehlen selected_tab If txtSerienNrNZ(selected_tab).Visible And txtSerienNrNZ(selected_tab).Enabled Then txtSerienNrNZ(selected_tab).SetFocus Else txtFabNr(selected_tab).SetFocus End If End Sub Private Function NaechsterBelegterTab(istart As Integer) As Integer Dim i As Integer Dim Pruefzaehler As CPruefzaehler Dim Einbauplatz As CEinbauplatz ' Anfang i = istart Set Pruefzaehler = Nothing ' Suche solange bis Prüfzähler gefunden wird Do While Pruefzaehler Is Nothing ' es gibt möglicherweise noch weitere eingebaute Zähler auf höheren Einbauplatzen i = i + 1 ' am Ende If i > 10 Then 'Am Anfang beginnen i = 1 End If If i = istart Then ' Am Startwert angekommen ' nichts gefunden i = -1 Exit Do End If Set Einbauplatz = m_colEinbauplatz.Item(i) Set Pruefzaehler = Einbauplatz.getPruefzaehler NaechsterBelegterTab = i Loop Debug.Print "Startbei " & istart & ", NaechsterBelegterTab = " & NaechsterBelegterTab; "" End Function Private Sub TabStrip_Auswaehlen(selected_tab As Integer) Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim bFlag1 As Boolean bFlag1 = False nochmal: ' Prüfzähler-Objekt zum ausgewählten Tab bestimmen Set Einbauplatz = m_colEinbauplatz.Item(selected_tab + 1) Set Pruefzaehler = Einbauplatz.getPruefzaehler Set m_Pruefzaehler = Pruefzaehler ' Frame zum letzten ausgewählten Tab unsichtbar machen frameTab(AltSelectedTab).Visible = False ' dafür aktuellen Frame sichtbar machen frameTab(selected_tab).Visible = True ' und nach vorne setzen frameTab(selected_tab).ZOrder ' Wenn Pruefzähler nicht definiert ist If Pruefzaehler Is Nothing Then ' Frame unsichtbar machen (sieht aus wie ein leerer TabStrip) frameTab(selected_tab).Visible = False ' zuletzt ausgewählten TabStrip wieder auswählen TabStrip1.Tabs.Item(AltSelectedTab + 1).Selected = True selected_tab = AltSelectedTab If bFlag1 = False Then bFlag1 = True GoTo nochmal End If Else AltSelectedTab = selected_tab End If ShowNZFehler selected_tab End Sub Private Sub checkToleranz(Index) Dim Fehler As Double Dim FGo As Double Dim Fgu As Double If lblFehler(Index).caption <> "" And lblFGo(Index).caption <> "" And lblFGu(Index).caption <> "" Then Fehler = CDbl(lblFehler(Index).caption) FGo = CDbl(lblFGo(Index).caption) Fgu = CDbl(lblFGu(Index).caption) If GrenzwertUeberschritten(FGo, Fehler, Fgu) Then lblFehler(Index).BackColor = &HC0C0FF Else lblFehler(Index).BackColor = &H8000000F End If Else lblFehler(Index).BackColor = &H8000000F End If End Sub Private Sub txtBehVol_LostFocus(Index As Integer) SetGotLostFocusColor txtBehVol(Index), False End Sub Private Sub txtFabNr_GotFocus(Index As Integer) SetGotLostFocusColor txtFabNr(Index), True End Sub Private Sub txtFabNr_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 13 Then If txtSerienNrNZ(Index).Visible And txtSerienNrNZ(Index).Enabled Then txtSerienNrNZ(Index).SetFocus Else txtQ(Index * 100).SetFocus End If End If End Sub Private Sub txtFabNr_LostFocus(Index As Integer) SetGotLostFocusColor txtFabNr(Index), False End Sub Private Sub txtHZStart_Change(Index As Integer) lblFehler(Index).Tag = "" checkToleranz (Index) End Sub Private Sub txtHZStart_LostFocus(Index As Integer) SetGotLostFocusColor txtHZStart(Index), False End Sub Private Sub txtHZStop_Change(Index As Integer) lblFehler(Index).Tag = "" checkToleranz (Index) End Sub Private Sub txtHZStop_GotFocus(Index As Integer) SetGotLostFocusColor txtHZStop(Index), True End Sub Private Sub txtHZStop_LostFocus(Index As Integer) SetGotLostFocusColor txtHZStop(Index), False End Sub Private Sub cmb2KundeneigeneSNr_KeyPress(Index As Integer, KeyAscii As MSForms.ReturnInteger) If KeyAscii = 13 Then If chkPruefNZ(Index).Enabled = True Then chkPruefNZ(Index).SetFocus End If End If End Sub 'Private Sub txtKundeneigeneSerienNrNZ_KeyPress(Index As Integer, KeyAscii As Integer) ' If KeyAscii = 13 Then ' If chkPruefNZ(Index).Enabled = True Then ' chkPruefNZ(Index).SetFocus ' End If ' End If 'End Sub Private Sub cmb2KundeneigeneSNr_LostFocus(Index As Integer) SetGotLostFocusColor cmb2KundeneigeneSNr(Index), False End Sub 'Private Sub txtKundeneigeneSerienNrNZ_LostFocus(Index As Integer) ' SetGotLostFocusColor txtKundeneigeneSerienNrNZ(Index), False 'End Sub Private Sub txtWasserVorlaufTemperatur_GotFocus() SetGotLostFocusColor txtWasserVorlaufTemperatur, True End Sub Private Sub txtWasserVorlaufTemperatur_LostFocus() SetGotLostFocusColor txtWasserVorlaufTemperatur, False End Sub Private Sub txtNZStart_Change(Index As Integer) lblFehler(Index).Tag = "" checkToleranz (Index) End Sub Private Sub txtNZStart_LostFocus(Index As Integer) SetGotLostFocusColor txtNZStart(Index), False End Sub Private Sub txtNZStop_Change(Index As Integer) lblFehler(Index).Tag = "" checkToleranz (Index) End Sub Private Sub txtBehVol_Change(Index As Integer) lblFehler(Index).Tag = "" checkToleranz (Index) End Sub Private Sub txtBehVol_Validate(Index As Integer, Cancel As Boolean) If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text) checkToleranz (Index) End Sub Private Sub txtHZStart_Validate(Index As Integer, Cancel As Boolean) If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub lblHZVol(Index).caption = BerechneDifTxt(txtHZStart(Index).text, txtHZStop(Index).text) lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text) checkToleranz (Index) lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption) End Sub Private Sub txtHZStop_Validate(Index As Integer, Cancel As Boolean) Dim frame_index As Integer If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub frame_index = Int(Index / 100) lblHZVol(Index).caption = BerechneDifTxt(txtHZStart(Index).text, txtHZStop(Index).text) lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text) lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption) checkToleranz (Index) If m_Pruefzaehler.IstVerbundZaehler Then ' Wenn Verbundzähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 7 If txtHZStop(Index).text <> "" And Index Mod 100 <= 7 Then If txtQ(Index + 1).text <> "" Then ' Übernehme StopWertes als nächsten StartWert If txtHZStop(Index + 1).text = "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt txtHZStart(Index + 1).text = txtHZStop(Index).text End If ' Übernehme Stopwert als Öffnen-Startwert und Schließen-Startwert If txtHZStop(frame_index * 100 + 8).text = "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt txtHZStart(frame_index * 100 + 8).text = txtHZStop(Index).text End If If txtHZStop(frame_index * 100 + 9).text = "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt txtHZStart(frame_index * 100 + 9).text = txtHZStop(Index).text End If End If End If Else ' Wenn kein eRegister und If mbln_eRegister = False Then ' Wenn normaler Zähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 9 If txtHZStop(Index).text <> "" And Index Mod 100 <= 9 Then ' Übernehme StopWertes als nächsten StartWert If txtHZStop(Index + 1).text = "" And txtQ(Index + 1).text <> "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt und Q vorhanden txtHZStart(Index + 1).text = txtHZStop(Index).text End If End If End If End If Call txtNZStop_Validate(Index, Cancel) End Sub Private Sub txtNZStart_Validate(Index As Integer, Cancel As Boolean) If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub lblNZVol(Index).caption = BerechneDifTxt(txtNZStart(Index).text, txtNZStop(Index).text) lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text) checkToleranz (Index) lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption) End Sub Private Sub txtNZStop_LostFocus(Index As Integer) SetGotLostFocusColor txtNZStop(Index), False End Sub Private Sub txtNZStop_Validate(Index As Integer, Cancel As Boolean) Dim frame_index As Integer If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub frame_index = Int(Index / 100) lblNZVol(Index).caption = BerechneDifTxt(txtNZStart(Index).text, txtNZStop(Index).text) lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text) checkToleranz (Index) lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption) If m_Pruefzaehler.IstVerbundZaehler Then ' Wenn Verbundzähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 7 If txtNZStop(Index).text <> "" And Index Mod 100 <= 7 Then If txtQ(Index + 1).text <> "" Then ' Übernehme StopWertes als nächsten StartWert If txtHZStop(Index + 1).text = "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt txtNZStart(Index + 1).text = txtNZStop(Index).text End If ' Übernehme Stopwert als Öffnen-Startwert If txtNZStop(frame_index * 100 + 8).text = "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt txtNZStart(frame_index * 100 + 8).text = txtNZStop(Index).text End If ' Übernehme Stopwert als Schließen-Startwert If txtNZStop(frame_index * 100 + 9).text = "" Then ' aber nur, wenn nächster Stopwert noch nicht gefüllt txtNZStart(frame_index * 100 + 9).text = txtNZStop(Index).text End If End If ' txtQ<>0 End If ' NZStop <> 0 and Index Mod 100 <= 7 Else ' Wenn normaler Zähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 9 If txtNZStop(Index).text <> "" And Index Mod 100 <= 9 Then ' Übernehme StopWertes als nächsten StartWert If txtNZStop(Index + 1).text = "" And txtQ(Index + 1).text <> "" Then txtNZStart(Index + 1).text = txtNZStop(Index).text End If End If End If End Sub Private Function BerechneMessfehlerTxt(VZH As String, VZN As String, VB As String) As String Dim dVZH As Double Dim dVZN As Double Dim dVB As Double Dim dVZ As Double Dim Fehler As Double If VZN = "" Then VZN = "0" If IsNumeric(VZH) And IsNumeric(VZN) And IsNumeric(VB) Then dVZ = CDbl(VZH) + CDbl(VZN) dVB = CDbl(VB) If dVB = 0 Then MsgBox ("Volumen kann nicht 0 sein") Exit Function End If If g_objExternePruefformel Is Nothing Then DebugMsg "Interne Pruefformel" Fehler = ((dVZ - dVB) / dVB) * 100 DebugMsg " dVZ=" & dVZ & ", dVB= " & dVB & ", Fehler = " & Fehler Else ' Fehlerberechnung in Externer DLL, neu RH 30.5.2017 Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(dVZ, dVB, 0) DebugMsg g_objExternePruefformel.GetLogText End If BerechneMessfehlerTxt = Format(Fehler, "0.0") Else BerechneMessfehlerTxt = "" End If End Function Private Function BerechneSummeTxt(VolHZ As String, VolNZ As String) As String If VolNZ = "" Then VolNZ = "0" If IsNumeric(VolHZ) And IsNumeric(VolNZ) Then BerechneSummeTxt = CStr(CDbl(VolHZ) + CDbl(VolNZ)) Else BerechneSummeTxt = "" End If End Function Private Function BerechneDifTxt(sStart As String, sStop As String) As String Dim dStart As Double Dim dStop As Double Dim dDif As Double If IsNumeric(sStart) And IsNumeric(sStop) Then dStart = CDbl(sStart) dStop = CDbl(sStop) dDif = dStop - dStart BerechneDifTxt = Format(dDif, "0.000") Else BerechneDifTxt = "" End If End Function Private Function ueberpruefe() As Boolean Dim i As Integer Dim j As Integer Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim SerienNr As Long Dim SerienNrNebenzaehler As Long Dim HauptzaehlerSerienNr As Long Screen.MousePointer = vbHourglass For i = 0 To 9 Set Einbauplatz = m_colEinbauplatz.Item(i + 1) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then SerienNr = Pruefzaehler.getSerienNr ''''''''''''''''''' ' Verbundzähler ' ''''''''''''''''''' If Pruefzaehler.IstVerbundZaehler Then ' Wenn Öffnen Prüfpunkt oder Schließen Prüfpunkt eingetragen ist, dann muss auch die ' Nebenzählerseriennr eingetragen werden: If txtQ(i * 100 + 8).text <> "" Or txtQ(i * 100 + 9).text <> "" Then If Val(txtSerienNrNZ(i).text) = 0 And Trim(cmb2KundeneigeneSNr(i).text) = "" Then ' TabStrip auswählen TabStrip1.Tabs.Item(i + 1).Selected = True MsgBox ("Die Nebenzähler Seriennummer oder Kundeneigene SerienNr muß eingetragen werden, wenn Öffnen- oder Schließen-Prüfpunkt eingetragen wurde.") txtSerienNrNZ(i).SetFocus Screen.MousePointer = vbNormal Exit Function End If SerienNrNebenzaehler = Val(txtSerienNrNZ(i).text) If SerienNrNebenzaehler > 0 Then If chkPruefNZ(i).value = 0 Then HauptzaehlerSerienNr = DoppelteHZSerienNr(SerienNr, SerienNrNebenzaehler) If HauptzaehlerSerienNr <> 0 Then MsgBox ("Der Nebenzähler " & SerienNrNebenzaehler & " wurde bereit mit dem Hauptzähler " & HauptzaehlerSerienNr & " geprüft." & vbCrLf _ & "Um diese Zähler zusammen prüfen zu können, muß der Nebenzähler als Prüfnebenzähler gewählt sein.") 'Geändert AP 25.09.2003; Wechsel auf den Tabstrip mit der falschen Nebenzählernummer If TabStrip1.Tabs.Item(i + 1).Selected = True Then txtSerienNrNZ(i).SetFocus Else TabStrip1.Tabs.Item(i + 1).Selected = True txtSerienNrNZ(i).SetFocus End If Screen.MousePointer = vbNormal Exit Function End If End If End If End If ' If (lblFehler(i * 100 + 8).Caption = "" And txtQ(i * 100 + 8).Text <> "") And mblnOeffnenSchliessenErgaenzen = True Then ' TabStrip1.Tabs.Item(i + 1).Selected = True ' MsgBox ("Bitte geben Sie auch die Daten für den 'Öffnen'-Prüfpunkt an") ' txtQ(i * 100 + 8).SetFocus ' Screen.MousePointer = vbNormal ' Exit Function ' End If ' ' If (lblFehler(i * 100 + 9).Caption = "" And txtQ(i * 100 + 9).Text <> "") And mblnOeffnenSchliessenErgaenzen = True Then ' TabStrip1.Tabs.Item(i + 1).Selected = True ' MsgBox ("Bitte geben Sie auch die Daten den 'Schließen'-Prüfpunkt an") ' txtQ(i * 100 + 8).SetFocus ' Screen.MousePointer = vbNormal ' Exit Function ' End If End If ' Verbundzähler '''''''''''''' ' Alle Zähler '''''''''''''' For j = 0 To 9 If txtQ(i * 100 + j).text = "" And lblHZVol(i * 100 + j).caption <> "" Then TabStrip1.Tabs.Item(i + 1).Selected = True MsgBox ("Es wurde kein Durchfluß eingetragen") txtQ(i * 100 + j).SetFocus Screen.MousePointer = vbNormal Exit Function End If ' wenn Pruefpunkt vorhanden, aber kein Fehler ermittelt worden ist If lblFehler(i * 100 + j).caption = "" And Val(txtQ(i * 100 + j).text) > 0 Then ' TabStrip auswählen TabStrip1.Tabs.Item(i + 1).Selected = True ' Hinweis und Fokus in Eingabefeld ErrorMsg ("Es konnte kein Fehler ermittelt werden für Pruefpunkt Q=" & Val(txtQ(i * 100 + j).text)) txtHZStart((i) * 100 + j).Enabled = True If txtHZStart((i) * 100 + j).Enabled = True Then txtHZStart((i) * 100 + j).SetFocus End If Screen.MousePointer = vbNormal Exit Function End If Next End If Next i ueberpruefe = True Screen.MousePointer = vbNormal End Function Private Sub txtQ_GotFocus(Index As Integer) txtQ(Index).SelStart = 0 txtQ(Index).SelLength = Len(txtQ(Index).text) SetGotLostFocusColor txtQ(Index), True End Sub Private Sub txtHZStart_GotFocus(Index As Integer) SetGotLostFocusColor txtHZStart(Index), True txtHZStart(Index).SelStart = 0 txtHZStart(Index).SelLength = Len(txtHZStart(Index).text) End Sub Private Sub txtNZStart_GotFocus(Index As Integer) SetGotLostFocusColor txtNZStart(Index), True txtNZStart(Index).SelStart = 0 txtNZStart(Index).SelLength = Len(txtNZStart(Index).text) End Sub Private Sub txtNZStop_GotFocus(Index As Integer) SetGotLostFocusColor txtNZStop(Index), True txtNZStop(Index).SelStart = 0 txtNZStop(Index).SelLength = Len(txtNZStop(Index).text) End Sub Private Sub txtBehVol_GotFocus(Index As Integer) SetGotLostFocusColor txtBehVol(Index), True txtBehVol(Index).SelStart = 0 txtBehVol(Index).SelLength = Len(txtBehVol(Index).text) End Sub Private Sub txtQ_LostFocus(Index As Integer) SetGotLostFocusColor txtQ(Index), False txtQ(Index).text = Trim(txtQ(Index).text) If Len(txtQ(Index).text) > 0 Then If Not IsNumericAndDouble(txtQ(Index).text) Then MsgBox "Bitte einen Numerischen Wert eingeben!" m_blnEingabeFehler = True txtQ(Index).SetFocus End If End If End Sub Private Sub txtQ_Validate(Index As Integer, Cancel As Boolean) txtQ(Index).text = Trim(txtQ(Index).text) If Len(txtQ(Index).text) > 0 Then If Not IsNumeric(txtQ(Index).text) Then ' MsgBox "Bitte einen Numerischen Wert eingeben!" ' m_blnEingabeFehler = True ' txtQ(Index).SetFocus End If End If End Sub Private Sub txtSerienNrNZ_DblClick(Index As Integer) Dim strAlteSerienNr As String Dim strNeueSerienNr As String ' bisherige NZ SerienNr anzeigen strAlteSerienNr = Trim(txtSerienNrNZ(Index).text) strNeueSerienNr = Trim(InputBox("Bitte geben Sie die NZ-SerienNr ein: ", "NZ SerienNr ändern", strAlteSerienNr)) If strNeueSerienNr <> "" And strNeueSerienNr <> strAlteSerienNr Then txtSerienNrNZ(Index).text = strNeueSerienNr ShowNZFehler (Index) End If End Sub Private Sub txtSerienNrNZ_GotFocus(Index As Integer) txtSerienNrNZ(Index).SelStart = 0 txtSerienNrNZ(Index).SelLength = Len(txtSerienNrNZ(Index).text) txtSerienNrNZ(Index).BackColor = vbYellow End Sub 'Private Sub txtKundeneigeneSerienNrNZ_gotFocus(Index As Integer) ' txtKundeneigeneSerienNrNZ(Index).SelStart = 0 ' txtKundeneigeneSerienNrNZ(Index).SelLength = Len(txtKundeneigeneSerienNrNZ(Index).text) ' SetGotLostFocusColor txtKundeneigeneSerienNrNZ(Index), True 'End Sub Private Sub cmb2KundeneigeneSNr_gotFocus(Index As Integer) cmb2KundeneigeneSNr(Index).SelStart = 0 cmb2KundeneigeneSNr(Index).SelLength = Len(cmb2KundeneigeneSNr(Index).text) SetGotLostFocusColor cmb2KundeneigeneSNr(Index), True End Sub Private Sub txtQ_KeyPress(Index As Integer, KeyAscii As Integer) Dim PPNr As Integer Dim neuIndex As Integer On Error GoTo Errorhandler PPNr = Index Mod 100 If KeyAscii = 46 Then KeyAscii = 0 If KeyAscii = 13 Then ' Enter Taste wurde gedrückt ' Überprüfen auf Eingabefehler m_blnEingabeFehler = False Call txtQ_LostFocus(Index) If Not m_blnEingabeFehler Then ' Eingabe-Inputbox für Fehler anzeigen lblFehler_DblClick (Index) If PPNr = 8 Then ' Ich bin in der Öffnen Spalte, also Fokus in den Schliessen Durchfluss txtQ(Index + 1).SetFocus txtQ_GotFocus (Index + 1) Else ' normale Prüfpunkte (nicht öffnen/schliessen) If m_blnSimpleInput Then If PPNr < 9 Then ' es gibt noch weiter rechts einen weiteren Durchfluss (Q-Schliessen) If txtQ(Index + 1).Visible And txtQ(Index + 1).Enabled Then ' Fokus in den nächsten Durchfluss, falls nicht gesperrt txtQ(Index + 1).SetFocus txtQ_GotFocus (Index + 1) Else If txtQ(AltSelectedTab * 100 + 8).Enabled Then ' Fokus in den Öffnen Durchfluss, falls Verbundzähler txtQ(AltSelectedTab * 100 + 8).SetFocus txtQ_GotFocus (AltSelectedTab * 100 + 8) Else ' Fokus in den 1. Durchfluss + nächster freier Tab, falls kein Verbundzähler neuIndex = NaechsterBelegterTab(AltSelectedTab + 1) Debug.Print "Nächster belegter Tab: " & neuIndex TabStrip1.Tabs(neuIndex).Selected = True DoEvents End If End If Else ' bin am Ende Debug.Print "bin am Ende mit Q" neuIndex = NaechsterBelegterTab(AltSelectedTab + 1) Debug.Print "Nächster belegter Tab: " & neuIndex TabStrip1.Tabs(neuIndex).Selected = True DoEvents End If End If End If Else ' Fokus in dasselbe Q-Eingabefeld txtQ(Index).SetFocus txtQ_GotFocus (Index) End If End If If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If Exit Sub Errorhandler: 'MsgBox "Fehler " & Err.Number & " in frmManuellDetails.txtQ_keyPress(index=" & index & ",keyAscii=" & KeyAscii & ") " & Err.Description LogIntoDB "Fehler " & Err.Number & " in frmManuellDetails.txtQ_keyPress(index=" & Index & ",keyAscii=" & KeyAscii & ") " & Err.Description, "Softwarefehler" ' Resume End Sub Private Sub txtHZStart_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 46 Then KeyAscii = 0 If KeyAscii = 13 Then Call txtHZStart_Validate(Index, False) txtHZStop(Index).SetFocus End If If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If End Sub Private Sub txtHZStop_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 46 Then KeyAscii = 0 If KeyAscii = 13 Then Call txtHZStop_Validate(Index, False) If txtNZStart(Index).Visible = True Then txtNZStart(Index).SetFocus Else txtBehVol(Index).SetFocus End If End If If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If End Sub Private Sub txtNZStart_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 46 Then KeyAscii = 0 If KeyAscii = 13 Then Call txtNZStop_Validate(Index, False) txtNZStop(Index).SetFocus End If If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If End Sub Private Sub txtNZStop_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 46 Then KeyAscii = 0 If KeyAscii = 13 Then Call txtNZStop_Validate(Index, False) txtBehVol(Index).SetFocus End If If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If End Sub Private Sub txtBehVol_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 46 Then KeyAscii = 0 If KeyAscii = 13 Then Call txtBehVol_Validate(Index, False) If (Index Mod 100) < 9 Then txtQ(Index + 1).SetFocus Else txtQ(Index - (Index Mod 100)).SetFocus End If End If If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If End Sub Private Sub txtSerienNrNZ_KeyPress(Index As Integer, KeyAscii As Integer) Dim blnCancel As Boolean Select Case KeyAscii Case 13 If txtQ(Index * 100).Enabled Then txtQ(Index * 100).SetFocus 'txtKundeneigeneSerienNrNZ(Index).SetFocus Call txtSerienNrNZ_Validate(Index, blnCancel) If blnCancel = False Then cmb2KundeneigeneSNr(Index).SetFocus End If End If Exit Sub End Select If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then If KeyAscii <> 8 Then KeyAscii = 0 End If End Sub ' Testet, ob der Durchfluss des uebergebenen Pruefpunkt-Objekts ' in der übergebenen Collection von Pruefpunkten enthalten ist. ' Private Function getEquivPruefpunktIndexFromCollection(TestPruefpunkt As CPruefpunkt, colPruefpunkte As CPruefpunktCol) As Integer Dim Pruefpunkt As CPruefpunkt Dim i As Integer For i = 1 To colPruefpunkte.Count Set Pruefpunkt = colPruefpunkte.Item(i) If Pruefpunkt.getQ() = TestPruefpunkt.getQ() Then getEquivPruefpunktIndexFromCollection = i Exit Function End If Next End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'todo: 'If g_blnZulassungspruefung Then ' Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, m_DurchflussSoll, QIst, Impulse / ImpulswertigkeitPZ * 1000, 1000 * BehaelterVolumen, Fehler, Temperatur, PPStartZeit, True) 'End If Private Sub PruefdatenSpeichern() Dim TabSeite As Integer Dim PruefpunktNr As Integer Dim Pruefpunkt As CPruefpunkt Dim AllePruefpunkte As CPruefpunkte Dim colPruefpunkte As CPruefpunktCol Dim AnzahlPZ As Integer Dim Pruefzaehler As CPruefzaehler Dim Fehler As Double Dim FGo As Double Dim Fgu As Double Dim Einbauplatz As CEinbauplatz Dim nPos As Integer Dim SpalteNr As Integer Dim KopiePruefpunkt As CPruefpunkt Dim AuftragpositionSerienNr As CAuftragPositionSerienNr Dim strTemp As String Dim PPZeit As Date ' Auf ausgefüllte Felder testen, ggf. Warnung, wenn Feld nicht ausgefüllt ' Sowie eindeutige Pruefpunkte feststellen Screen.MousePointer = vbHourglass PPZeit = Now() m_Pruefgang.PrueferNr = g_App.Mitarbeiter.getNr If Val(txtWasserVorlaufTemperatur.text) > 0 Then txtWasserVorlaufTemperatur.text = Replace(txtWasserVorlaufTemperatur.text, ",", ".") m_Pruefgang.Vorlauftemperatur = Val(txtWasserVorlaufTemperatur.text) End If MesseWetterdaten m_Pruefgang.LuftDruck = g_dblLuftDruck m_Pruefgang.Lufttemperatur = g_dblLuftTemperatur m_Pruefgang.RelativeFeuchte = g_dblLuftFeuchte 'Geändert AP am 25.11.03 Unterdrückung der Prüfstationsnummer ' bei der Ergänzung der Prüfdaten Öffnen/Schließen If mblnOeffnenSchliessenErgaenzen = False Then 'm_Pruefgang.PruefstationNr = g_App.PruefstationNr End If Set colPruefpunkte = New CPruefpunktCol AnzahlPZ = 0 For TabSeite = 1 To 10 Set Einbauplatz = m_colEinbauplatz.Item(TabSeite) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then ' Für jeden eingebauten Zähler ' zählen AnzahlPZ = AnzahlPZ + 1 ' Setzen des Ist-geprüft Status Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 30 Pruefzaehler.getAuftragPositionSerienNr.AlterStatusFlag StatusFlagBits.StatusFlagWert_Rueckwaerts_geprueft, m_blnRueckwaertspruefung 'Neu RH 23.4.2008 If Val(txtFabNr(TabSeite - 1).text) > 0 Then ' wegen dem Index Speicherabbild.FabNr mit AuftragpositionSerienNr.FabNr If CheckAndCreateInSpeicherabbild(TabSeite - 1, Val(txtFabNr(TabSeite - 1).text)) Then Pruefzaehler.getAuftragPositionSerienNr.setFabNr Val(txtFabNr(TabSeite - 1).text) Else MsgBox "Speicherabbild Datensatz für FabNr " & Val(txtFabNr(TabSeite - 1).text) & " wurde nicht gespeichert." End If End If If AnzahlPZ = 1 Then ' Es handelt sich um den ersten eingebauten Zähler m_Pruefgang.Typ = Pruefzaehler.getIdentNrObj.getTyp m_Pruefgang.Typzusatz = Pruefzaehler.getIdentNrObj.getTypzusatz m_Pruefgang.Nennweite = Pruefzaehler.getIdentNrObj.getNennweite m_Pruefgang.Nenntemperatur = Pruefzaehler.getIdentNrObj.GetTemperatur End If For SpalteNr = 0 To IIf(Pruefzaehler.IstVerbundZaehler, 7, 9) ' Alle Pruefpunkte ohne Öffnen / Schliessen Debug.Print SpalteNr & ": " & txtQ((TabSeite - 1) * 100 + SpalteNr).text If txtQ((TabSeite - 1) * 100 + SpalteNr).text <> "" Then Set Pruefpunkt = New CPruefpunkt ' Pruefpunkt vorhanden Pruefpunkt.setQ CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr).text) If lblFGo((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then Pruefpunkt.setFGo CDbl(lblFGo((TabSeite - 1) * 100 + SpalteNr).caption) Pruefpunkt.setFGu CDbl(lblFGu((TabSeite - 1) * 100 + SpalteNr).caption) End If ' Pruefpunkt zur Collection hinzuaddieren '''''''''''''''''''''''''''''''''''''''''' nPos = getEquivPruefpunktIndexFromCollection(Pruefpunkt, colPruefpunkte) If nPos = 0 Then Debug.Print "neuer Pruefpunkt: " & Pruefpunkt.getQ Set KopiePruefpunkt = New CPruefpunkt KopiePruefpunkt.copyFrom Pruefpunkt Call KopiePruefpunkt.setUseCount(1) colPruefpunkte.Add KopiePruefpunkt Else Call colPruefpunkte.Item(nPos).incUseCount Debug.Print " wdh Pruefpunkt: " & Pruefpunkt.getQ End If End If Next ' SpalteNr End If ' not Pruefzaehler is nothing Next TabSeite m_Pruefgang.Anzahl = AnzahlPZ If mblnOeffnenSchliessenErgaenzen = True And m_Pruefgang.PruefgangNr > 0 Then 'Neu RH 24.9.2006 ' Prüfgang wird bei Verbundzählern nicht mehr überschrieben Else m_Pruefgang.save End If colPruefpunkte.sortQ PruefpunktNr = 0 For Each Pruefpunkt In colPruefpunkte.getCollection PruefpunktNr = PruefpunktNr + 1 m_Pruefgang.PP_Soll(PruefpunktNr) = CSng(Pruefpunkt.getQ) m_Pruefgang.PP_Ist(PruefpunktNr) = CSng(Pruefpunkt.getQ) m_Pruefgang.save Debug.Print "- - - - - - - - - - - - - - " Debug.Print "Pruefpunkt PP" & PruefpunktNr & " mit Q=" & Pruefpunkt.getQ Debug.Print "Wird benutzt von " & Pruefpunkt.getUseCount & " Pruefzählern" For TabSeite = 1 To 10 Set Einbauplatz = m_colEinbauplatz.Item(TabSeite) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then For SpalteNr = 0 To IIf(Pruefzaehler.IstVerbundZaehler, 7, 9) ' Alle Pruefpunkte ohne Öffnen / Schliessen Debug.Print "SpalteNr: " & SpalteNr & ", Val(txtQ): " & Val(txtQ((TabSeite - 1) * 100 + SpalteNr).text) Debug.Print " Index: " & (TabSeite - 1) * 100 + SpalteNr Debug.Print " txt:" & txtQ((TabSeite - 1) * 100 + SpalteNr).text If txtQ((TabSeite - 1) * 100 + SpalteNr).text <> "" Then If CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr)) > 0 Then Debug.Print "vergl: " & Pruefpunkt.getQ & " mit " & CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr).text) If Pruefpunkt.getQ = CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr).text) And lblFehler((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then Fehler = CDbl(lblFehler((TabSeite - 1) * 100 + SpalteNr).caption) ' Prüfzähler-Prüfpunkt '''''''''''''''''''''' Debug.Print "---------------------" Debug.Print " Einbauplatz " & Einbauplatz.getNr Debug.Print " SNr=" & FormatSerienNr(Pruefzaehler.getSerienNr) Debug.Print " Q =" & txtQ((TabSeite - 1) * 100 + SpalteNr) Debug.Print " Fehler: " & CStr(Fehler) If g_blnZulassungspruefung Then Dim dblIndicatedVolumen As Double Dim dblActualVolumen As Double If lblVol((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then dblIndicatedVolumen = CDbl(lblVol((TabSeite - 1) * 100 + SpalteNr).caption) End If If txtBehVol((TabSeite - 1) * 100 + SpalteNr).text <> "" Then dblActualVolumen = CDbl(txtBehVol((TabSeite - 1) * 100 + SpalteNr).text) End If Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, Pruefpunkt.getQ, Pruefpunkt.getQ, dblIndicatedVolumen, dblActualVolumen, Fehler, 0, PPZeit, False) End If ' Wenn Grenzwert Überschritten, dann AuftragPositionSerienNr.StatusFertigung = 25 ' If lblFGo((TabSeite - 1) * 100 + SpalteNr).caption <> "" And lblFGu((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then FGo = CDbl(lblFGo((TabSeite - 1) * 100 + SpalteNr).caption) Fgu = CDbl(lblFGu((TabSeite - 1) * 100 + SpalteNr).caption) If GrenzwertUeberschritten(FGo, Fehler, Fgu) Then Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25 ' neu 18.8.2016 Bugfix Pruefzaehler.getAuftragPositionSerienNr.save Debug.Print "Grenzwert überschritten in Spalte " & SpalteNr End If End If If Not FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, PruefpunktNr) Then ErrorMsg ("FehlerSpeichernError mit PPNr=" & PruefpunktNr & " und SerienNr=" & FormatSerienNr(Pruefzaehler.getSerienNr)) End If ' FehlerSpeichern End If 'PP.getQ = txtQ End If 'txtQ<>"" End If ' CDbl(txtQ) > 0 Next ' SpalteNr End If ' not Pruefzaehler is nothing Next ' tabSeite Next ' Pruefpunkt ' Verbundzähler-Daten und AuftragPositionSerienNr-Daten speichern For TabSeite = 1 To 10 Set Einbauplatz = m_colEinbauplatz.Item(TabSeite) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If Pruefzaehler.IstVerbundZaehler Then ' Verbundzähler Daten speichern Debug.Print "Verbundzähler: " Debug.Print " SNr=" & FormatSerienNr(Pruefzaehler.getSerienNr) Debug.Print " PruefgangNr=" & m_Pruefgang.PruefgangNr Debug.Print " PP_Oeffnen=" & txtQ((TabSeite - 1) * 100 + 8) Debug.Print " PP_Oefnnen_Fehler=" & lblFehler((TabSeite - 1) * 100 + 8) Debug.Print " PP_Schliessen=" & txtQ((TabSeite - 1) * 100 + 9) Debug.Print " PP_SchliessenFehler=" & lblFehler((TabSeite - 1) * 100 + 9) Debug.Print " SerienNrNebenzähler=" & txtSerienNrNZ(TabSeite - 1) Debug.Print " Kundeneigene SerienNrNebenzähler=" & cmb2KundeneigeneSNr(TabSeite - 1) Debug.Print " Prüfnebenzähler=" & chkPruefNZ(TabSeite - 1) ' Fehlergrenzen Öffnen Schliessen überprüfen ' öffnen Debug.Print lblFehler((TabSeite - 1) * 100 + 8) Debug.Print lblFGo((TabSeite - 1) * 100 + 8).caption Debug.Print lblFGu((TabSeite - 1) * 100 + 8).caption ' schliessen Debug.Print lblFehler((TabSeite - 1) * 100 + 9) Debug.Print lblFGo((TabSeite - 1) * 100 + 9).caption Debug.Print lblFGu((TabSeite - 1) * 100 + 9).caption If IsNumeric(lblFGo((TabSeite - 1) * 100 + 8).caption) And IsNumeric(lblFehler((TabSeite - 1) * 100 + 8).caption) And IsNumeric(lblFGu((TabSeite - 1) * 100 + 8).caption) Then If GrenzwertUeberschritten(Val(lblFGo((TabSeite - 1) * 100 + 8).caption), Val(lblFehler((TabSeite - 1) * 100 + 8).caption), Val(lblFGu((TabSeite - 1) * 100 + 8).caption)) Then Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25 End If End If If IsNumeric(lblFGo((TabSeite - 1) * 100 + 9).caption) And IsNumeric(lblFehler((TabSeite - 1) * 100 + 9).caption) And IsNumeric(lblFGu((TabSeite - 1) * 100 + 9).caption) Then If GrenzwertUeberschritten(Val(lblFGo((TabSeite - 1) * 100 + 9).caption), Val(lblFehler((TabSeite - 1) * 100 + 9).caption), Val(lblFGu((TabSeite - 1) * 100 + 9).caption)) Then Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25 End If End If Call VerbundzaehlerSpeichern(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, txtQ((TabSeite - 1) * 100 + 8), lblFehler((TabSeite - 1) * 100 + 8).caption, txtQ((TabSeite - 1) * 100 + 9), lblFehler((TabSeite - 1) * 100 + 9), txtSerienNrNZ(TabSeite - 1).text, CBool(chkPruefNZ(TabSeite - 1).value), cmb2KundeneigeneSNr(TabSeite - 1).text, Pruefzaehler.getAuftragPosition) ' neu RH 19.3.2012 Dim NZPruefdaten As NZ_PRUEFDATEN_TYP Dim blnSchonvorhanden As Boolean NZPruefdaten.SerienNrNebenzaehler = Val(txtSerienNrNZ(TabSeite - 1)) NZPruefdaten.KundeneigeneSerienNrNZ = Trim(cmb2KundeneigeneSNr(TabSeite - 1).text) If NZPruefdaten.SerienNrNebenzaehler > 0 Or NZPruefdaten.KundeneigeneSerienNrNZ <> "" Then If GetNZPruefdaten(Pruefzaehler.getSerienNr, NZPruefdaten, blnSchonvorhanden) Then If blnSchonvorhanden = False Then Call SetNZPruefdaten(Pruefzaehler.getSerienNr, NZPruefdaten) End If End If End If End If '--------------------------------------------------------------------------- ' wenn kompletter Pruefgang bendet: ' Doublizieren des Datensatzes in Tabelle AuftragPositionSerienNr und setzen ' der neuen Angaben ' Kopieren des AuftragPositionSerienNr Objektes incl. aller Daten '--------------------------------------------------------------------------- Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr ' Setzen der neuen Werte: PgangDatum, PgangNr, Einbauplatz, AnlageDatum, MitarbeiterNr AuftragpositionSerienNr.setPruefgangDatum m_Pruefgang.Datum AuftragpositionSerienNr.setPruefgangNr m_Pruefgang.PruefgangNr AuftragpositionSerienNr.setEinbauplatzNr Einbauplatz.getNr AuftragpositionSerienNr.setAnlageDatum Now() AuftragpositionSerienNr.setAnlageMitarbeiterNr g_App.Mitarbeiter.getNr 'Angaben für Änderung löschen AuftragpositionSerienNr.setAenderungDatum Empty AuftragpositionSerienNr.setAenderungMitarbeiterNr Empty ' Metrologische Klasse unter der diese Prüfung durchgeführt wurde If Pruefzaehler.getPruefklasseKZ <> "" Then AuftragpositionSerienNr.setMetrolog Pruefzaehler.getPruefklasseKZ Else AuftragpositionSerienNr.setMetrolog Pruefzaehler.getPruefpunkte.getPruefklasseKZ End If ' Speichern als neuer Datensatz If mblnOeffnenSchliessenErgaenzen = True Then AuftragpositionSerienNr.save False Else ' Hochzählen des Wiederholungszählers (-1 = Original Datensatz, 0 = 1. Pruefung, 1 = 1.Wdh AuftragpositionSerienNr.setWiederholungen AuftragpositionSerienNr.getWiederholungen + 1 AuftragpositionSerienNr.save True ' As New End If '--------------------------------------------------------------------------- End If ' Pruefzaehler is not nothing Next TabSeite For TabSeite = 1 To 10 Set Einbauplatz = m_colEinbauplatz.Item(TabSeite) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then Pruefzaehler.getAuftragPosition.UpdateTLMenge_P Pruefzaehler.getAuftragPosition.save Pruefzaehler.getAuftrag If g_blnZulassungspruefung Then Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, 0, 0, 0, 0, 0, 0, PPZeit) End If End If Next ' Neu RH 28.3.2017 Verschiebe_Prueffehler_Befundpruefung_Eichung m_Pruefgang.PruefgangNr Screen.MousePointer = vbNormal End Sub Private Function FehlerSpeichern(Fehler As Double, Pruefzaehler As CPruefzaehler, Pruefgang As CPruefgang, PruefpunktNr As Integer) On Error GoTo FehlerSpeichernError Dim PruefgangNr As Long Dim SerienNr As Long Dim PPNr As Integer Dim rs As CRecordset Dim Feldname As String Dim sSQL As String PruefgangNr = Pruefgang.PruefgangNr SerienNr = Pruefzaehler.getSerienNr Set rs = New CRecordset sSQL = "SELECT * from Prueffehler where PruefgangNr=" & PruefgangNr & " and SerienNr=" & SerienNr & ";" rs.openRS (sSQL) Debug.Print sSQL If rs.EOF Then rs.addNew End If Call rs.setValue("SerienNr", SerienNr) Call rs.setValue("PruefgangNr", PruefgangNr) Feldname = "PP" & CStr(PruefpunktNr) & "_Fehler" Debug.Print "Feldname=" & Feldname & "; Fehler=" & Fehler Call rs.setValue(Feldname, Fehler) Call rs.setValue("PruefDatum", Now) Call rs.update FehlerSpeichern = True Exit Function FehlerSpeichernError: ErrorMsg ("FehlerSpeichern fehlgeschlagen: " & Err.Description) End Function Private Function VerbundzaehlerSpeichern(SerienNr As Long, PruefgangNr As Long, strPP_Oeffnen As String, strPP_OeffnenFehler As String, strPP_Schliessen As String, strPP_SchliessenFehler As String, strSerienNrNebenzaehler As String, bPruefNZ As Boolean, Optional strKundeneigeneSerienNrNZ As String = "", Optional objAuftragPosition As CAuftragPosition) As Boolean On Error GoTo VerbundzaehlerSpeichernError Dim rs As CRecordset Dim Feldname As String Dim sSQL As String Set rs = New CRecordset sSQL = "SELECT * from Verbundzaehler where PruefgangNr=" & PruefgangNr & " and SerienNr=" & SerienNr & ";" rs.openRS sSQL, False If rs.EOF Then sSQL = "SELECT * from Verbundzaehler where PruefgangNr=0 and SerienNr=" & SerienNr & ";" rs.openRS sSQL, False If rs.EOF Then rs.addNew End If End If Call rs.setValue("SerienNr", SerienNr) Call rs.setValue("PruefgangNr", PruefgangNr) If Val(strPP_Oeffnen) <> 0 Then Call rs.setValue("PP_Oeffnen", strPP_Oeffnen) Call rs.setValue("PP_OeffnenFehler", strPP_OeffnenFehler) End If If Val(strPP_Schliessen) <> 0 Then Call rs.setValue("PP_Schliessen", strPP_Schliessen) Call rs.setValue("PP_SchliessenFehler", strPP_SchliessenFehler) End If If rs.getStringValue("SerienNrNebenzaehler") <> strSerienNrNebenzaehler Then ' NZSerienNr wurde geändert, also alle Daten zum NZ löschen. ' Diese werden dann durch die Funktion SetNZPruefdaten wieder aktualisiert. rs.setValue "Q1_SOLL", Null rs.setValue "FEHLER_Q1", Null rs.setValue "Q2_SOLL", Null rs.setValue "FEHLER_Q2", Null rs.setValue "MetrologNZ", Null rs.setValue "Herkunft", Null End If If Val(strSerienNrNebenzaehler) <> 0 Then Call rs.setValue("SerienNrNebenzaehler", strSerienNrNebenzaehler) Call rs.setValue("Pruefnebenzaehler", bPruefNZ) End If If strKundeneigeneSerienNrNZ <> "" Then Call rs.setValue("KundeneigeneSerNrNbZ", strKundeneigeneSerienNrNZ) End If Call rs.setValue("PrueferNr", g_App.Mitarbeiter.getNr) Call rs.setValue("Datum", Now()) ' neu RH 17.11.2010 Call rs.setValue("Info_FertigungsauftragNr", objAuftragPosition.GetFertigungsauftragNr) Call rs.update VerbundzaehlerSpeichern = True Exit Function VerbundzaehlerSpeichernError: ErrorMsg ("VerbundzaehlerSpeichern fehlgeschlagen: " & Err.Description) VerbundzaehlerSpeichern = False End Function Private Function DoppelteHZSerienNr(SerienNr As Long, SerienNrNebenzaehler As Long) As Long ' Gibt 0 zurück, wenn keine NZSerienNr doppelt ist, sonst SerienNr des zugehörigen HZ ' Bei einem Fehler wird ebenfalls 0 zurückgegeben On Error GoTo DoppelteHZSerienNrError Dim rs As CRecordset Dim sSQL As String Set rs = New CRecordset sSQL = "select * from Verbundzaehler where SerienNrNebenzaehler = " & SerienNrNebenzaehler & " and SerienNr <>" & SerienNr & " and Pruefnebenzaehler = 0;" Debug.Print sSQL rs.openRS (sSQL) If Not rs.EOF Then DoppelteHZSerienNr = CLng(rs.getLongValue("SerienNr")) Else DoppelteHZSerienNr = 0 End If Exit Function DoppelteHZSerienNrError: ErrorMsg "Es konnte nicht ermittelt werden, ob die NZ-SNr schon mal verwendet wurde: " & Err.Description End Function Private Sub fillPrueffehler(lngPruefgangNr As Long) Dim rs As CRecordset Dim sSQL As String Dim i As Integer Dim j As Integer Dim PPNr As Integer Dim intGesperrte As Integer Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim lngSerienNrNebenzaehler As Long Dim strKndEigeneSerienNrNebenzaehler As String Dim blnIstPruefnebenzaehler As Boolean Dim dblPPOeffnen As Double Dim dblPPSchliessen As Double Dim dblPP_OeffnenFehler As Double Dim dblPP_SchliessenFehler As Double Set rs = New CRecordset sSQL = "SELECT Prueffehler.* , Pruefgang.* FROM (Pruefgang INNER JOIN Prueffehler" sSQL = sSQL & " ON Pruefgang.PruefgangNr = Prueffehler.PruefgangNr)" sSQL = sSQL & " WHERE Pruefgang.PruefgangNr = " & lngPruefgangNr sSQL = sSQL & " ORDER BY Prueffehler.SerienNr" rs.openRS sSQL, True Debug.Print sSQL ' für alle Zähler des Prüfgangs Do While Not rs.EOF For i = 0 To 9 'Suche den Zähler in allen 10 Einbauplätzen 'Debug.Print TabStrip1.Tabs.Item(i + 1).Caption & " = " & CStr(rs.getLongValue("SerienNr")) If Val(TabStrip1.Tabs.Item(i + 1).Tag) = rs.getLongValue("SerienNr") Then ' Zähler gefunden Debug.Print "SerienNr: " & CStr(rs.getLongValue("SerienNr")) Set Einbauplatz = m_colEinbauplatz(i + 1) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Pruefzaehler.getAuftragPositionSerienNr.getFabNr <> 0 Then txtFabNr(i).text = Pruefzaehler.getAuftragPositionSerienNr.getFabNr End If If Pruefzaehler.IstVerbundZaehler = True Then ' Es ist ein Verbundzähler, also die ersten 8 Eingabefelder der Prüfpunkte sperren intGesperrte = 8 Else ' Es ist kein Verbundzähler, also die ersten 10 Eingabefelder der Prüfpunkte sperren intGesperrte = 10 End If ' für alle Pruefpunkte For PPNr = 1 To 10 If PPNr <= intGesperrte Then ' Prüfpunkt Eingabefleder sperren ' nur Öffnen und Schließen zulassen lblFehler(i * 100 + PPNr - 1).Enabled = False txtQ(i * 100 + PPNr - 1).Enabled = False lblFGo(i * 100 + PPNr - 1).Enabled = False lblFGo(i * 100 + PPNr - 1).Enabled = False lblHZVol(i * 100 + PPNr - 1).Enabled = False lblNZVol(i * 100 + PPNr - 1).Enabled = False txtBehVol(i * 100 + PPNr - 1).Enabled = False txtHZStart(i * 100 + PPNr - 1).Enabled = False txtHZStop(i * 100 + PPNr - 1).Enabled = False txtNZStart(i * 100 + PPNr - 1).Enabled = False txtNZStop(i * 100 + PPNr - 1).Enabled = False End If Debug.Print " Q=" & txtQ(i * 100 + PPNr - 1).text ' Suche Q in txtQ If IsNumeric(txtQ(i * 100 + PPNr - 1).text) Then For j = 1 To 10 If Val(txtQ(i * 100 + PPNr - 1).text) = Val(rs.getDoubleValue("PP" & j & "_Soll")) Then ' Wenn Q gefunden wurde, Fehler eintragen If Not rs.isFieldNull("PP" & j & "_Fehler") Then lblFehler(i * 100 + PPNr - 1).caption = Round(rs.getDoubleValue("PP" & j & "_Fehler"), 2) Debug.Print "Fehler: feld=" & (i * 100 + PPNr - 1) & ": " & rs.getDoubleValue("PP" & j & "_Fehler") End If If lblFehler(i * 100 + PPNr - 1).caption = "" Then 'zum Nachtragen noch leerer Fehler Felder lblFehler(i * 100 + PPNr - 1).Enabled = True txtQ(i * 100 + PPNr - 1).Enabled = True lblFGo(i * 100 + PPNr - 1).Enabled = True lblFGo(i * 100 + PPNr - 1).Enabled = True lblHZVol(i * 100 + PPNr - 1).Enabled = True lblNZVol(i * 100 + PPNr - 1).Enabled = True txtBehVol(i * 100 + PPNr - 1).Enabled = True txtHZStart(i * 100 + PPNr - 1).Enabled = True txtHZStop(i * 100 + PPNr - 1).Enabled = True txtNZStart(i * 100 + PPNr - 1).Enabled = True txtNZStop(i * 100 + PPNr - 1).Enabled = True End If End If Next End If Next If GetNebenzaehlerDaten(m_Pruefgang.PruefgangNr, rs.getLongValue("SerienNr"), lngSerienNrNebenzaehler, strKndEigeneSerienNrNebenzaehler, blnIstPruefnebenzaehler, dblPPOeffnen, dblPPSchliessen, dblPP_OeffnenFehler, dblPP_SchliessenFehler) = 0 Then txtSerienNrNZ(i).text = FormatSerienNr(lngSerienNrNebenzaehler) 'txtKundeneigeneSerienNrNZ(i).text = strKndEigeneSerienNrNebenzaehler cmb2KundeneigeneSNr(i).text = strKndEigeneSerienNrNebenzaehler If blnIstPruefnebenzaehler Then chkPruefNZ(i).value = vbChecked End If If dblPPOeffnen > 0 Then txtQ(i * 100 + 8) = dblPPOeffnen lblFehler(i * 100 + 8) = Round(dblPP_OeffnenFehler, 2) End If If dblPPSchliessen > 0 Then txtQ(i * 100 + 9) = dblPPSchliessen lblFehler(i * 100 + 9) = Round(dblPP_SchliessenFehler, 2) End If End If ' Nebenzaehlerdaten vorhanden End If Next rs.MoveNext Loop txtWasserVorlaufTemperatur.text = m_Pruefgang.Vorlauftemperatur End Sub ' TODO seit 24.1.2003 Private Function GetNebenzaehlerDaten(lngPruefgangNr As Long, lngSerienNr As Long, ByRef SerienNrNebenzaehler As Long, ByRef KndEigeneSerienNrNebenzaehler As String, ByRef blnIstPruefnebenzaehler As Boolean, ByRef dblPP_Oeffnen As Double, ByRef dblPP_Schliessen As Double, ByRef dblPP_OeffnenFehler As Double, ByRef dblPP_SchliessenFehler As Double) As Long On Error GoTo Errorhandler Dim rs As CRecordset Dim sSQL As String Set rs = New CRecordset If lngPruefgangNr = 0 Then sSQL = "select * from Verbundzaehler where SerienNr = " & lngSerienNr & " ORDER BY Datum desc" Else sSQL = "select * from Verbundzaehler where PruefgangNr = " & CStr(lngPruefgangNr) & " and SerienNr = " & lngSerienNr End If rs.openRS (sSQL) If Not rs.EOF Then SerienNrNebenzaehler = CLng(rs.getLongValue("SerienNrNebenzaehler")) KndEigeneSerienNrNebenzaehler = rs.getStringValue("KundeneigeneSerNrNbZ") blnIstPruefnebenzaehler = rs.getBooleanValue("Pruefnebenzaehler") dblPP_Oeffnen = rs.getDoubleValue("PP_Oeffnen") dblPP_OeffnenFehler = rs.getDoubleValue("PP_OeffnenFehler") dblPP_Schliessen = rs.getDoubleValue("PP_Schliessen") dblPP_SchliessenFehler = rs.getDoubleValue("PP_SchliessenFehler") GetNebenzaehlerDaten = 0 Else DebugMsg "Es gibt keinen Verbundzähler für Prüfzaehler " & lngSerienNr & " im Prüfgang " & lngPruefgangNr GetNebenzaehlerDaten = -2 End If Exit Function Errorhandler: ErrorMsg "GetNebenzaehlerDaten: Fehler " & Err.Description & ": " & Err.Description GetNebenzaehlerDaten = -1 End Function Private Sub txtSerienNrNZ_LostFocus(Index As Integer) txtSerienNrNZ(Index).BackColor = -2147483643 End Sub Private Sub SetGotLostFocusColor(TheObject As Object, blnGotFocus As Boolean) If blnGotFocus Then TheObject.BackColor = vbYellow Else TheObject.BackColor = &H80000005 End If End Sub Private Function IsNumericAndDouble(strNumber As String) As Boolean If IsNumeric(strNumber) Then IsNumericAndDouble = True End If End Function Private Function CheckPruefnebenzaehler(Index As Integer) As Boolean Dim lngSerienNrNZ As Long lngSerienNrNZ = Val(txtSerienNrNZ(Index).text) 'If lngSerienNrNZ > 0 Then ' Nebenzähler ist eingegeben If chkPruefNZ(Index).value = vbChecked Then ' Prüfer hat diesen Nebenzähler als Prüfnebenzähler deklariert If Not IstPruefnebenzaehler(lngSerienNrNZ) Then DoEvents 'Nebenzähler ist aber kein Prüfnebenzähler MsgBox "Nebenzaehler " & lngSerienNrNZ & " ist kein Prüfnebenzähler! Bitte geben Sie die korrekte Serien-Nr ein." chkPruefNZ(Index).value = vbUnchecked If txtSerienNrNZ(Index).Enabled = True Then cmdOK.Enabled = False chkPruefNZ(Index).value = vbUnchecked txtSerienNrNZ(Index).SetFocus End If End If End If 'End If End Function Private Function IstPruefnebenzaehler(lngSerienNrNebenzaehler As Long) As Boolean Dim strSQL As String Dim rs As CRecordset strSQL = "SELECT * From Pruefnebenzaehler WHERE SerienNr = " & lngSerienNrNebenzaehler Set rs = New CRecordset rs.openRS strSQL, True If Not rs.EOF Then IstPruefnebenzaehler = True End If End Function Private Sub chkPruefNZ_Click(Index As Integer) UeberprüfePruefnebenzaehlerserienNr Index End Sub Private Sub chkPruefNZ_Validate(Index As Integer, Cancel As Boolean) UeberprüfePruefnebenzaehlerserienNr Index End Sub Private Sub UeberprüfePruefnebenzaehlerserienNr(Index As Integer) cmdOK.Enabled = True If chkPruefNZ(Index).value = vbChecked Then CheckPruefnebenzaehler (Index) If chkPruefNZ(Index).value = vbChecked Then 'mb2KundeneigeneSNr(Index).Enabled = False Else cmb2KundeneigeneSNr(Index).Enabled = True End If Else cmb2KundeneigeneSNr(Index).Enabled = True End If End Sub Private Sub Fillcmb2KundeneigeneSNr(lngFANr As Long, Index As Integer) Dim strSQL As String Dim rs As CRecordset Set rs = New CRecordset strSQL = "SELECT KundeneigeneSerNrNbZ From Verbundzaehler Where Info_FertigungsauftragNr = " & lngFANr rs.openRS strSQL, True Do While Not rs.EOF cmb2KundeneigeneSNr(Index).AddItem rs.getStringValue("KundeneigeneSerNrNbZ") rs.MoveNext 'cmb2KundeneigeneSNr(Index).Style = fmStyleDropDownList Loop End Sub Private Sub FillFehlergrenzenVerbundzaehler(iTabIndex As Integer) Dim Pruefzaehler As CPruefzaehler Dim Pruefpunkte As CPruefpunkte Dim dblFGoOeff As Double Dim dblFGuOeff As Double Dim dblFGoSchl As Double Dim dblFGuSchl As Double Set Pruefzaehler = m_colEinbauplatz.Item(iTabIndex + 1).getPruefzaehler If Not Pruefzaehler Is Nothing Then Set Pruefpunkte = Pruefzaehler.getPruefpunkte If Pruefzaehler.getPruefpunkte.GetFehlergrenzenOeffnenSchliessen(dblFGoOeff, dblFGuOeff, dblFGoSchl, dblFGuSchl) Then Debug.Print dblFGoOeff, dblFGuOeff, dblFGoSchl, dblFGuSchl lblFGo(iTabIndex * 100 + 9 - 1).caption = dblFGoOeff lblFGu(iTabIndex * 100 + 9 - 1).caption = dblFGuOeff lblFGo(iTabIndex * 100 + 10 - 1).caption = dblFGoSchl lblFGu(iTabIndex * 100 + 10 - 1).caption = dblFGuSchl End If End If End Sub Private Sub txtSerienNrNZ_Validate(Index As Integer, ByRef Cancel As Boolean) Dim lngSerienNr As Long Dim lngSerienNrNZ As Long lngSerienNr = m_colEinbauplatz.Item(Index + 1).getPruefzaehler.getSerienNr txtSerienNrNZ(Index).text = Trim(txtSerienNrNZ(Index).text) If Trim(Str(Val(txtSerienNrNZ(Index).text))) <> txtSerienNrNZ(Index).text And txtSerienNrNZ(Index).text <> "" Then MsgBox "Bitte geben Sie die NZ SerienNr rein numerisch ein." Cancel = True Exit Sub End If lngSerienNrNZ = Val(txtSerienNrNZ(Index).text) If lngSerienNr = lngSerienNrNZ Then Call MsgBox("Die Nebenzähler SerienNr ist gleich der SerienNr. Bitte überprüfen!", vbCritical) txtSerienNrNZ(Index).Locked = False txtSerienNrNZ(Index).Enabled = True txtSerienNrNZ(Index).SetFocus txtSerienNrNZ(Index).SelStart = 0 txtSerienNrNZ(Index).SelLength = Len(txtSerienNrNZ(Index).text) Cancel = True Exit Sub End If '' todo: SerienNrNz darf noch nicht in Tabelle Verbundzähler oder Formular eingetragen sein, sonst Warnung anzeigen If txtSerienNrNZ(Index) <> "" Then ShowNZFehler Index Else MSFlexGrid1.Visible = False End If End Sub Private Sub cmdNZInfo_Click(Index As Integer) ShowNZFehler Index End Sub Private Function GetNZPruefdaten(ByVal lngSerienNr As Long, ByRef NZPruefdaten As NZ_PRUEFDATEN_TYP, ByRef blnSchonvorhanden As Boolean) As Boolean On Error GoTo Errorhandler Dim strSQL As String Dim rs As CRecordset Dim rsLU As CRecordset If lngSerienNr = 0 Then Exit Function If NZPruefdaten.SerienNrNebenzaehler > 0 Then ' SerienNr des NZ bekannt strSQL = "SELECT * from [Verbundzaehler] where SerienNrNebenzaehler = " & NZPruefdaten.SerienNrNebenzaehler & " and Q1_soll > 0 and SerienNr = " & lngSerienNr ElseIf NZPruefdaten.KundeneigeneSerienNrNZ <> "" Then ' sind lokale Daten vorhanden für den Nebenzähler in dieser Kombination vorhanden? strSQL = "SELECT * from [Verbundzaehler] where KundeneigeneSerNrNbZ = '" & NZPruefdaten.KundeneigeneSerienNrNZ & "' and Q1_soll > 0 and SerienNr = " & lngSerienNr Else Exit Function End If Set rs = New CRecordset rs.openRS strSQL, False Debug.Print strSQL If rs.EOF Then 'es sind KEINE lokalen Daten vorhanden, also holen aus anderer Tabelle Set rsLU = GetNZPruefdatenAusLuRecordset(NZPruefdaten.SerienNrNebenzaehler) If Not rsLU Is Nothing Then If Not rsLU.EOF Then GetNZPruefdaten = True ' Es sind Daten aus LU vorhanden 'NZPruefdaten.MetrologNZ = rsLU.getStringValue("MetrologNZ") NZPruefdaten.Q1_Soll = Round(rsLU.getDoubleValue("Q1_SOLL") / 1000, 3) NZPruefdaten.Fehler_Q1 = Round(Val(rsLU.getStringValue("FEHLER_Q1")), 2) NZPruefdaten.Fehler_Q2 = Round(Val(rsLU.getStringValue("FEHLER_Q2")), 2) NZPruefdaten.Q2_Soll = Round(rsLU.getDoubleValue("Q2_SOLL") / 1000, 3) Else 'Es sind KEINE Daten aus LU vorhanden Set rsLU = GetNZPruefdatenAusMetegraRecordset(NZPruefdaten.SerienNrNebenzaehler) If Not rsLU.EOF Then GetNZPruefdaten = True ' Es sind Daten von Metegra vorhanden NZPruefdaten.MetrologNZ = rsLU.getStringValue("MetrologNZ") NZPruefdaten.Q1_Soll = Round(rsLU.getDoubleValue("Q1_SOLL") / 1000, 3) NZPruefdaten.Fehler_Q1 = Round(rsLU.getDoubleValue("FEHLER_Q1"), 2) NZPruefdaten.Q2_Soll = Round(rsLU.getDoubleValue("Q2_SOLL") / 1000, 3) NZPruefdaten.Fehler_Q2 = Round(rsLU.getDoubleValue("FEHLER_Q2"), 2) Else ' Es sind auch KEINE Daten von Metegra vorhanden GetNZPruefdaten = False Exit Function End If End If Else ' Fehler End If Else GetNZPruefdaten = True blnSchonvorhanden = True 'Daten sind schon vorhanden NZPruefdaten.Q1_Soll = Round(rs.getDoubleValue("Q1_SOLL"), 2) NZPruefdaten.Fehler_Q1 = Round(rs.getDoubleValue("FEHLER_Q1"), 2) NZPruefdaten.Q2_Soll = Round(rs.getDoubleValue("Q2_SOLL"), 3) NZPruefdaten.Fehler_Q2 = Round(rs.getDoubleValue("FEHLER_Q2"), 2) NZPruefdaten.MetrologNZ = rs.getStringValue("MetrologNZ") End If Exit Function Errorhandler: LogIntoDB "Fehler " & Err.Number & " in GetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description, "NZPruefdaten" MsgBox "Fehler " & Err.Number & " in GetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description End Function Private Sub SetNZPruefdaten(ByVal lngSerienNr As Long, ByRef NZPruefdaten As NZ_PRUEFDATEN_TYP) On Error GoTo Errorhandler Dim strSQL As String Dim rs As CRecordset strSQL = "SELECT * from [Verbundzaehler] where SerienNrNebenzaehler = " & NZPruefdaten.SerienNrNebenzaehler & " and SerienNr = " & lngSerienNr Set rs = New CRecordset Debug.Print strSQL rs.openRS strSQL, False If rs.EOF Then rs.addNew rs.setValue "SerienNr", lngSerienNr End If Do While Not rs.EOF rs.setValue "SerienNrNebenzaehler", NZPruefdaten.SerienNrNebenzaehler rs.setValue "Q1_SOLL", NZPruefdaten.Q1_Soll rs.setValue "FEHLER_Q1", NZPruefdaten.Fehler_Q1 rs.setValue "Q2_SOLL", NZPruefdaten.Q2_Soll rs.setValue "FEHLER_Q2", NZPruefdaten.Fehler_Q2 rs.setValue "MetrologNZ", NZPruefdaten.MetrologNZ rs.update rs.MoveNext Loop Exit Sub Errorhandler: LogIntoDB "Fehler " & Err.Number & " in SetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description, "NZPruefdaten" MsgBox "Fehler " & Err.Number & " in SetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description End Sub Private Function GetNZPruefdatenAusMetegraRecordset(lngSerienNrNZ As Long) As CRecordset On Error GoTo Errorhandler Dim rs As CRecordset Dim strSQL As String strSQL = "SELECT * from Metegra_Pruefergebnisse where [SerienNrNebenzaehler]= " & lngSerienNrNZ Set rs = New CRecordset Debug.Print strSQL rs.openRS strSQL Set GetNZPruefdatenAusMetegraRecordset = rs Exit Function Errorhandler: LogIntoDB "Fehler " & Err.Number & " in GetNZPruefdatenAusMetegraRecordset(" & lngSerienNrNZ & "): " & Err.Description, "NZPruefdaten" MsgBox "Fehler " & Err.Number & " in GetNZPruefdatenAusMetegraRecordset(" & lngSerienNrNZ & "): " & Err.Description End Function Private Function GetNZPruefdatenAusLuRecordset(lngSerienNrNZ As Long) As CRecordset On Error GoTo Errorhandler Dim rs As CRecordset Dim strSQL As String Dim errnum As Long Dim errdesc As String strSQL = "SELECT * FROM OPENQUERY( MyOraDB, 'SELECT * FROM PRIMA_RO.DT01_LAATZEN where ZAEHLERNUMMER = ''" & lngSerienNrNZ & "''') " Set rs = New CRecordset Debug.Print strSQL rs.openRS strSQL Set GetNZPruefdatenAusLuRecordset = rs Exit Function Errorhandler: errnum = Err.Number errdesc = Err.Description LogIntoDB "Fehler " & errnum & " in GetNZPruefdatenAusLuRecordset(" & lngSerienNrNZ & "): " & errdesc, "NZPruefdaten" MsgBox "Die Prüfergebnisse aus Ludwigshafen können zur Zeit nicht abgerufen werden." & vbCrLf & "Fehler " & errnum & " in GetNZPruefdatenAusLuRecordset(" & lngSerienNrNZ & "): " & errdesc End Function Private Sub ShowNZFehler(Index As Integer) On Error GoTo Errorhandler Dim lngSerienNrNZ As Long Dim lngSerienNr As Long Dim strKundeneigeneSNrNZ As String Dim blnPrf_nach_MID As Boolean Dim strSQL As String Dim rs As CRecordset Dim col As Long Dim row As Long Dim strVal As String Dim NZPruefdaten As NZ_PRUEFDATEN_TYP If Not IsNumeric(txtSerienNrNZ(Index).text) Then MSFlexGrid1.Visible = False Exit Sub End If If Val(txtSerienNrNZ(Index).text) = 0 Then ' hier ist die Seriennr des Nebenzählers zwar nicht bekannt aber es könnte ja sein, das es eine KundeneigeneSnr des NZ gibt If Trim(cmb2KundeneigeneSNr(Index).text) <> "" Then strKundeneigeneSNrNZ = Trim(cmb2KundeneigeneSNr(Index).text) cmb2KundeneigeneSNr(Index).Enabled = False Else MSFlexGrid1.Visible = False Exit Sub End If End If blnPrf_nach_MID = GetPrfNachMID(Index + 1) lngSerienNr = m_colEinbauplatz.Item(Index + 1).getPruefzaehler.getSerienNr lngSerienNrNZ = Val(txtSerienNrNZ(Index).text) If lngSerienNrNZ = Val(MSFlexGrid1.TextMatrix(1, 0)) Then If MSFlexGrid1.Visible = True Then Exit Sub End If End If cmdNZInfo(Index).Enabled = False Me.MousePointer = vbHourglass NZPruefdaten.SerienNrNebenzaehler = lngSerienNrNZ Dim blnSchonvorhanden As Boolean NZPruefdaten.KundeneigeneSerienNrNZ = strKundeneigeneSNrNZ If GetNZPruefdaten(lngSerienNr, NZPruefdaten, blnSchonvorhanden) Then MSFlexGrid1.Left = txtInfoVerbundzaehler.Left MSFlexGrid1.Top = txtInfoVerbundzaehler.Top MSFlexGrid1.Width = txtInfoVerbundzaehler.Width MSFlexGrid1.Height = txtInfoVerbundzaehler.Height MSFlexGrid1.Clear MSFlexGrid1.FormatString = "SerienNr NZ | Q1 Soll | Fehler Q1 | Q2 Soll | Fehler Q2|Metrolog" MSFlexGrid1.Rows = 2 MSFlexGrid1.FixedRows = 1 MSFlexGrid1.Cols = 6 If NZPruefdaten.KundeneigeneSerienNrNZ <> "" Then MSFlexGrid1.TextMatrix(1, 0) = NZPruefdaten.KundeneigeneSerienNrNZ Else MSFlexGrid1.TextMatrix(1, 0) = NZPruefdaten.SerienNrNebenzaehler End If MSFlexGrid1.TextMatrix(1, 1) = NZPruefdaten.Q1_Soll MSFlexGrid1.TextMatrix(1, 2) = Round(NZPruefdaten.Fehler_Q1, 2) MSFlexGrid1.TextMatrix(1, 3) = NZPruefdaten.Q2_Soll MSFlexGrid1.TextMatrix(1, 4) = Round(NZPruefdaten.Fehler_Q2, 2) MSFlexGrid1.TextMatrix(1, 5) = NZPruefdaten.MetrologNZ MSFlexGrid1.Visible = True Else If blnPrf_nach_MID Then txtInfoVerbundzaehler.text = txtInfoVerbundzaehler.text & vbCrLf & "Dieser Zähler darf NICHT geprüft werden, da für den Nebenzähler " & lngSerienNrNZ & " keine Prüfergbenisse vorliegen." txtInfoVerbundzaehler.BackColor = RGB(255, 128, 128) ' light red txtInfoVerbundzaehler.FontBold = True Else txtInfoVerbundzaehler.text = "Für den Nebenzähler " & lngSerienNrNZ & " liegen keine Prüfergbenisse vor." txtInfoVerbundzaehler.BackColor = RGB(255, 255, 128) ' light red txtInfoVerbundzaehler.FontBold = False End If MSFlexGrid1.Visible = False End If Fertig: Me.MousePointer = vbNormal cmdNZInfo(Index).Enabled = True Exit Sub Errorhandler: LogIntoDB "Fehler " & Err.Number & " in ShowNZFehler(" & Index & "): " & Err.Description, "NZPruefdaten" MsgBox "Fehler " & Err.Number & " in ShowNZFehler(" & Index & "): " & Err.Description End Sub Private Function GetPrfNachMID(Index As Integer) As Boolean On Error GoTo Errorhandler Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim AuftragPosition As CAuftragPosition Set Einbauplatz = m_colEinbauplatz.Item(Index) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then Set AuftragPosition = Pruefzaehler.getAuftragPosition GetPrfNachMID = AuftragPosition.getPrf_nach_MID End If Exit Function TrueSprung: GetPrfNachMID = True Exit Function Errorhandler: LogIntoDB "Fehler " & Err.Number & " in GetPrfNachMID(" & Index & ")" & Err.Description End Function Private Sub cmdeRegisterpruefpunkt_Click() Dim dblVolumen As Double Dim PPNr As Integer Dim dblBehaelterVBolumen As Double PPNr = Val(cmbeRegisterPP.text) Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz frmeRegisterPrf.mblnManuellePruefung = True MsgBox "Klicken Sie auf OK um den Start-Zählerstand auszulesen. Danach starten Sie bitte den Durchfluss." frmeRegisterPrf.Show vbNormal, Me frmeRegisterPrf.Visible = True frmeRegisterPrf.MesspunktAufnehmen Sleep 2000 frmeRegisterPrf.Visible = False Dim Einbauplatz As CEinbauplatz Dim eRegister_Auftragposition As CeRegister_Auftragposition Dim FAKTOR As Double For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then If Not Einbauplatz.eRegister Is Nothing Then ' Einheit vom LED Pulse ist Milliliter , Umrechnung in m³ txtHZStart((Einbauplatz.getNr - 1) * 100 + PPNr - 1) = Val(frmeRegisterPrf.MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr)) / 1000 txtHZStart_Validate ((Einbauplatz.getNr - 1) * 100 + PPNr - 1), False End If End If Next dblBehaelterVBolumen = Val(Replace(InputBox("Bitte geben Sie das Volumen im Behälter in Litern an, wenn der Behälter gefüllt ist. Danach wird das Zählerstand erneut ausgelesen."), ",", ".")) If dblBehaelterVBolumen = 0 Then Exit Sub End If frmeRegisterPrf.Visible = True frmeRegisterPrf.MesspunktAufnehmen Sleep 2000 frmeRegisterPrf.Visible = False For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then If Not Einbauplatz.eRegister Is Nothing Then ' Behlter Volumen wurde in Litern angegeben. Umechnung in m³ txtBehVol((Einbauplatz.getNr - 1) * 100 + PPNr - 1) = dblBehaelterVBolumen txtBehVol_Validate ((Einbauplatz.getNr - 1) * 100 + PPNr - 1), False ' Einheit vom LED Pulse ist Milliliter , Umrechnung in m³ txtHZStop((Einbauplatz.getNr - 1) * 100 + PPNr - 1) = Val(frmeRegisterPrf.MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr)) / 1000 txtHZStop_Validate ((Einbauplatz.getNr - 1) * 100 + PPNr - 1), False End If End If Next If cmbeRegisterPP.ListIndex < cmbeRegisterPP.ListCount - 1 Then cmbeRegisterPP.ListIndex = cmbeRegisterPP.ListIndex + 1 End If End Sub