VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmSeriennrAuswahl 
   BorderStyle     =   4  'Festes Werkzeugfenster
   Caption         =   "Seriennr auswählen"
   ClientHeight    =   6495
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   10890
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6495
   ScaleWidth      =   10890
   StartUpPosition =   2  'Bildschirmmitte
   Begin VB.CheckBox chkSensusSerNrAnzeigen 
      Caption         =   "Sensus SerienNr anzeigen"
      Height          =   225
      Left            =   4410
      TabIndex        =   26
      Top             =   4080
      Width           =   2385
   End
   Begin VB.Frame Frame3 
      Caption         =   "Auftrags - Kurzinformation:"
      Height          =   1665
      Left            =   7110
      TabIndex        =   23
      Top             =   2730
      Width           =   2685
      Begin VB.Label lblKunde 
         BorderStyle     =   1  'Fest Einfach
         Height          =   1365
         Left            =   90
         TabIndex        =   24
         Top             =   210
         Width           =   2505
      End
   End
   Begin VB.CommandButton cmdNachKundeneigeneSerienNrSuchen 
      Caption         =   "Suchen"
      Height          =   285
      Left            =   9030
      TabIndex        =   22
      ToolTipText     =   "Beim Anklicken werden die noch freien Seriennummern gesucht"
      Top             =   2400
      Width           =   765
   End
   Begin VB.TextBox txtKundeneigeneSerienNr 
      Height          =   285
      Left            =   7230
      TabIndex        =   20
      Top             =   2370
      Width           =   1785
   End
   Begin VB.CommandButton cmdNachFertAuftragSuchen 
      Caption         =   "Suchen"
      Height          =   285
      Left            =   9060
      TabIndex        =   19
      ToolTipText     =   "Beim Anklicken werden die noch freien Seriennummern gesucht"
      Top             =   1770
      Width           =   765
   End
   Begin VB.TextBox txtFertigungsAuftragNr 
      Height          =   285
      Left            =   7230
      TabIndex        =   3
      Top             =   1770
      Width           =   1785
   End
   Begin VB.Frame Frame2 
      Caption         =   "Letztes Prüfergebnis des angewählten Zählers"
      Height          =   1575
      Left            =   0
      TabIndex        =   14
      Top             =   4890
      Width           =   10845
      Begin MSFlexGridLib.MSFlexGrid grdPrfErgebnis 
         Height          =   855
         Left            =   60
         TabIndex        =   16
         Top             =   600
         Width           =   6855
         _ExtentX        =   12091
         _ExtentY        =   1508
         _Version        =   393216
         Cols            =   11
      End
      Begin VB.Label lblMeldung 
         Caption         =   "lblMeldung"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   1185
         Left            =   7110
         TabIndex        =   29
         Top             =   270
         Width           =   3555
      End
      Begin VB.Label lblPruefInfo 
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   360
         Width           =   6735
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Bedeutungen der Farben"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3135
      Left            =   4260
      TabIndex        =   10
      Top             =   750
      Width           =   2775
      Begin VB.CheckBox chkerfolgreichGepruefteAnzeigen 
         Caption         =   "bereits erfolgreich geprüfte ROT DURCHGESTRICHEN anzeigen"
         ForeColor       =   &H000000FF&
         Height          =   705
         Left            =   120
         TabIndex        =   28
         Top             =   1200
         Width           =   2445
      End
      Begin VB.Label Label4 
         Caption         =   "BRAUN: FabNr vergeben"
         ForeColor       =   &H000040C0&
         Height          =   375
         Left            =   120
         TabIndex        =   17
         Top             =   840
         Width           =   2055
      End
      Begin VB.Label lblInfoSeriennr 
         BackColor       =   &H00C0FFC0&
         Caption         =   "GRÜN: aktuell ausgewählt"
         Height          =   435
         Index           =   4
         Left            =   120
         TabIndex        =   13
         Top             =   2460
         Width           =   2295
      End
      Begin VB.Label lblInfoSeriennr 
         Caption         =   "BLAU: Grenzwert überschritten"
         ForeColor       =   &H00FF0000&
         Height          =   435
         Index           =   3
         Left            =   120
         TabIndex        =   12
         Top             =   2010
         Width           =   2295
      End
      Begin VB.Label lblInfoSeriennr 
         Caption         =   "SCHWARZ: freie Seriennummer"
         Height          =   435
         Index           =   1
         Left            =   120
         TabIndex        =   11
         Top             =   480
         Width           =   2295
      End
   End
   Begin MSFlexGridLib.MSFlexGrid grdSeriennr 
      Height          =   3945
      Left            =   90
      TabIndex        =   0
      Top             =   360
      Width           =   4095
      _ExtentX        =   7223
      _ExtentY        =   6959
      _Version        =   393216
      Cols            =   1
      FixedCols       =   0
      BackColorSel    =   12632256
      ForeColorSel    =   0
      GridColor       =   8421504
      AllowBigSelection=   0   'False
      FocusRect       =   2
      HighLight       =   2
      ScrollBars      =   2
      SelectionMode   =   1
      AllowUserResizing=   3
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Abbrechen"
      Height          =   345
      Left            =   7320
      TabIndex        =   4
      ToolTipText     =   "Abbrechen ohne eine Seriennummer in die Eingabemaske zu übertragen"
      Top             =   4470
      Width           =   1035
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "Übernehmen"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   345
      Left            =   8670
      TabIndex        =   5
      Top             =   4440
      Width           =   1095
   End
   Begin VB.CommandButton cmdSuchen 
      Caption         =   "Suchen"
      Enabled         =   0   'False
      Height          =   375
      Left            =   9060
      TabIndex        =   6
      ToolTipText     =   "Beim Anklicken werden die noch freien Seriennummern gesucht"
      Top             =   1080
      Width           =   765
   End
   Begin VB.TextBox txtAuftrag 
      Height          =   285
      Left            =   7260
      TabIndex        =   1
      ToolTipText     =   "Eingabe der gewünschten Auftragsnummer"
      Top             =   1140
      Width           =   945
   End
   Begin VB.TextBox txtPosition 
      Height          =   285
      Left            =   8340
      TabIndex        =   2
      ToolTipText     =   "Eingabe der gewünschten Positionsnummer"
      Top             =   1140
      Width           =   555
   End
   Begin VB.Label lblSensusSerNr 
      Alignment       =   1  'Rechts
      BorderStyle     =   1  'Fest Einfach
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4410
      TabIndex        =   27
      Top             =   4350
      Width           =   2145
   End
   Begin VB.Label lblAutosize 
      BorderStyle     =   1  'Fest Einfach
      Caption         =   "Autosize"
      Height          =   285
      Left            =   660
      TabIndex        =   25
      Top             =   0
      Visible         =   0   'False
      Width           =   795
   End
   Begin VB.Label Label6 
      Caption         =   "Kundeneigene SerienNr"
      Height          =   225
      Left            =   7230
      TabIndex        =   21
      Top             =   2160
      Width           =   2505
   End
   Begin VB.Label Label5 
      Caption         =   "Fertigungsauftrag Nr."
      Height          =   225
      Left            =   7260
      TabIndex        =   18
      Top             =   1530
      Width           =   2535
   End
   Begin VB.Line Line6 
      BorderColor     =   &H00FF8080&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   2250
      X2              =   2130
      Y1              =   4470
      Y2              =   4590
   End
   Begin VB.Line Line5 
      BorderColor     =   &H00FF8080&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   2100
      X2              =   2100
      Y1              =   4470
      Y2              =   4590
   End
   Begin VB.Line Line4 
      BorderColor     =   &H00FF8080&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   2100
      X2              =   1980
      Y1              =   4590
      Y2              =   4470
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00FF8080&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   2220
      X2              =   2100
      Y1              =   270
      Y2              =   150
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FF8080&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   2070
      X2              =   1950
      Y1              =   150
      Y2              =   270
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FF8080&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   2070
      X2              =   2070
      Y1              =   150
      Y2              =   270
   End
   Begin VB.Label Label2 
      Caption         =   "Prüfen und ändern Sie die Auftragsnummer, dann wählen Sie die gewünschte Seriennummer aus."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   525
      Left            =   4650
      TabIndex        =   9
      Top             =   60
      Width           =   5145
   End
   Begin VB.Label Label1 
      Caption         =   "PositionNr"
      Height          =   225
      Left            =   8250
      TabIndex        =   8
      Top             =   900
      Width           =   795
   End
   Begin VB.Label lblAuftrag 
      Caption         =   "AuftragNr"
      Height          =   225
      Left            =   7290
      TabIndex        =   7
      Top             =   900
      Width           =   825
   End
End
Attribute VB_Name = "frmSeriennrAuswahl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public sSerienNr As String
Public lngAuftrag As Long
Private lngPosition As Long
Private m_lngLastSelectedRow As Long
Private blnAbbruch As Boolean

Const INIKEY_1 = "SeriennummernAuswahlGepruefteAnzeigen"
Const INISECTION_1 = "Vorbelegung"

Private Sub chkerfolgreichGepruefteAnzeigen_Click()
    If chkerfolgreichGepruefteAnzeigen.Enabled = False Then
        Exit Sub
    End If
    
    If chkerfolgreichGepruefteAnzeigen.value = vbUnchecked Then
        'lblInfoSeriennr(2).Enabled = True
        Call g_App.Settings.saveStringValue(INISECTION_1, INIKEY_1, "0")
        GepruefteZaehlerAusblenden (True)
    Else
        'lblInfoSeriennr(2).Enabled = False
        Call g_App.Settings.saveStringValue(INISECTION_1, INIKEY_1, "1")
        GepruefteZaehlerAusblenden (False)
    End If
        
End Sub

Private Sub GepruefteZaehlerAusblenden(blnAusblenden As Boolean)
    Dim lngRow As Long
    Dim lngRowVorher As Long
    
    lngRowVorher = grdSeriennr.row
    
    grdSeriennr.row = lngRow
    
    For lngRow = 1 To grdSeriennr.Rows - 1
        grdSeriennr.row = lngRow
        grdSeriennr.col = 1
        If grdSeriennr.CellFontStrikeThrough = True Then
            If blnAusblenden Then
                grdSeriennr.RowHeight(lngRow) = 0
            Else
                ' wie Überschriftzeile
                grdSeriennr.RowHeight(lngRow) = grdSeriennr.RowHeight(0)
            End If
        End If
    Next
    
    grdSeriennr.row = lngRowVorher
End Sub
    
Private Sub chkSensusSerNrAnzeigen_Click()
    If chkSensusSerNrAnzeigen.Enabled = True Then
        If chkSensusSerNrAnzeigen.value = vbChecked Then
            VersteckeSensusSerienNr False
            g_ValuechkSensusSerNrAnzeigen = True
        Else
            VersteckeSensusSerienNr True
            g_ValuechkSensusSerNrAnzeigen = False
        End If
    End If
End Sub




Private Sub cmdNachFertAuftragSuchen_Click()
   On Error Resume Next

    cmdNachFertAuftragSuchen.Enabled = False
    Me.MousePointer = vbHourglass
    If NachFertAuftragSuchen(txtFertigungsAuftragNr.text) Then
       grdSeriennr.SetFocus
    Else
        txtFertigungsAuftragNr.SetFocus
    End If
    Me.MousePointer = vbNormal
    cmdNachFertAuftragSuchen.Enabled = True
End Sub


Private Sub cmdNachKundeneigeneSerienNrSuchen_Click()
Dim i As Integer
cmdNachKundeneigeneSerienNrSuchen.Enabled = False
Me.MousePointer = vbHourglass
    If NachKundeneigeneSerienNrSuchen(txtKundeneigeneSerienNr.text) Then
        For i = 1 To grdSeriennr.Rows - 1
            grdSeriennr.row = i
            grdSeriennr.col = 2
            If UCase(Trim(grdSeriennr.text)) = UCase(Trim(txtKundeneigeneSerienNr.text)) Then
                grdSeriennr.col = 1
                grdSeriennr.SetFocus
                Exit For
            End If
        Next
        grdSeriennr_SelChange
    Else
        txtKundeneigeneSerienNr.SetFocus
        txtKundeneigeneSerienNr.BackColor = vbRed
    End If
Me.MousePointer = vbNormal
cmdNachKundeneigeneSerienNrSuchen.Enabled = True
End Sub





'Eingefügt am 24.07.2002 Pfeiffer
Private Sub Form_Activate()
    'Unload Me
    'Exit Sub
    'Letzte Auftrag/Position aus Ini Datei holen
    lblSensusSerNr.Caption = ""
    
    If g_lngSerienNr > 0 Then
        Dim rs As CRecordset
        Dim strSQL As String
        strSQL = "SELECT AuftragNr, PositionNr From AuftragPositionSerienNr Where (SerienNr = " & g_lngSerienNr & ") ORDER BY AnlageDatum DESC"
        
        Set rs = New CRecordset
        rs.openRS strSQL, True
        If Not rs.EOF Then
            lngAuftrag = rs.getLongValue("AuftragNr")
            lngPosition = rs.getLongValue("PositionNr")
        End If
    Else
        If g_App.Settings.LetzterAuftrag > 2 ^ 31 - 1 Then
            g_App.Settings.LetzterAuftrag = 0
            g_App.Settings.LetztePosition = 0
        End If
        
        lngAuftrag = Val(g_App.Settings.LetzterAuftrag)
        lngPosition = Val(g_App.Settings.LetztePosition)
    End If
    
    
    txtAuftrag.text = lngAuftrag
    txtPosition.text = lngPosition
    'und die Seriennummerliste füllen
    
    ' Falls Haken noch nicht in INI Datei gesetzt
    Call g_App.Settings.GetOrSetIniWert(INISECTION_1, INIKEY_1, "1")
    
    chkerfolgreichGepruefteAnzeigen.Enabled = False
    If g_App.Settings.readStringValue(INISECTION_1, INIKEY_1, "") = "1" Then
        ' Erfolgreich geprüfte SerienNr anzeigen
        chkerfolgreichGepruefteAnzeigen.value = vbChecked
        
    Else
        ' Erfolgreich geprüfte SerienNr ausblenden
        chkerfolgreichGepruefteAnzeigen.value = vbUnchecked
    End If
    chkerfolgreichGepruefteAnzeigen.Enabled = True
    
    chkSensusSerNrAnzeigen.Enabled = False
    If g_ValuechkSensusSerNrAnzeigen = True Then
        chkSensusSerNrAnzeigen.value = vbChecked
    Else
        chkSensusSerNrAnzeigen.value = vbUnchecked
    End If
    chkSensusSerNrAnzeigen.Enabled = True
    
    Call suche
    
    
    
    If txtFertigungsAuftragNr.Enabled = True And txtFertigungsAuftragNr.Visible = True Then
        txtFertigungsAuftragNr.SetFocus
    End If
    txtFertigungsAuftragNr.SelStart = 0
    txtFertigungsAuftragNr.SelLength = Len(txtFertigungsAuftragNr.text)
    
    
    
    
End Sub



Private Sub Prueferergebnisanzeigen()
    Dim sSQL As String
    Dim rs As CRecordset
    Dim mystr As String
    
    'Grid löschen
    grdPrfErgebnis.Clear
    grdSeriennr.col = 1
    
    
    If Val(grdSeriennr.text) = 0 Then
        lblSensusSerNr.Caption = ""
        Exit Sub
    End If
    lblSensusSerNr.Caption = grdSeriennr.text
    
    
    
    'Abfrage nach letztes Prüfergebnis der angeklickten Seriennummer mit Durchflüssen
    'todo: Fehlergrenzwerte anzeigen
    sSQL = "SELECT TOP 1 Prueffehler.SerienNr, Max(AuftragPositionSerienNr.Wiederholungen) AS [Max von Wiederholungen], Pruefgang.PruefgangNr, Pruefgang.PP1_Soll, Pruefgang.PP2_Soll, Pruefgang.PP3_Soll, Pruefgang.PP4_Soll, Pruefgang.PP5_Soll, Pruefgang.PP6_Soll, Pruefgang.PP7_Soll, Pruefgang.PP8_Soll, Pruefgang.PP9_Soll, Pruefgang.PP10_Soll, Prueffehler.PP1_Fehler, Prueffehler.PP2_Fehler, Prueffehler.PP3_Fehler, Prueffehler.PP4_Fehler, Prueffehler.PP5_Fehler, Prueffehler.PP6_Fehler, Prueffehler.PP7_Fehler, Prueffehler.PP8_Fehler, Prueffehler.PP9_Fehler, Prueffehler.PP10_Fehler,AuftragPositionSerienNr.AuftragNr " _
    & "FROM (Pruefgang INNER JOIN Prueffehler ON Pruefgang.PruefgangNr = Prueffehler.PruefgangNr) INNER JOIN AuftragPositionSerienNr ON (AuftragPositionSerienNr.SerienNr = Prueffehler.SerienNr) AND (Pruefgang.PruefgangNr = AuftragPositionSerienNr.Pruefgangnr) " _
    & "GROUP BY Prueffehler.SerienNr, Pruefgang.PruefgangNr, Pruefgang.PP1_Soll, Pruefgang.PP2_Soll, Pruefgang.PP3_Soll, Pruefgang.PP4_Soll, Pruefgang.PP5_Soll, Pruefgang.PP6_Soll, Pruefgang.PP7_Soll, Pruefgang.PP8_Soll, Pruefgang.PP9_Soll, Pruefgang.PP10_Soll, Prueffehler.PP1_Fehler, Prueffehler.PP2_Fehler, Prueffehler.PP3_Fehler, Prueffehler.PP4_Fehler, Prueffehler.PP5_Fehler, Prueffehler.PP6_Fehler, Prueffehler.PP7_Fehler, Prueffehler.PP8_Fehler, Prueffehler.PP9_Fehler, Prueffehler.PP10_Fehler,AuftragPositionSerienNr.AuftragNr " _
    & "Having ((Prueffehler.SerienNr) = " & Val(Trim(grdSeriennr.text)) & ")" _
    & " AND AuftragPositionSerienNr.AuftragNr = " & Val(txtAuftrag.text) _
    & " ORDER BY Max(AuftragPositionSerienNr.Wiederholungen) DESC;"

    Set rs = New CRecordset
    rs.openRS sSQL, True
    
    If rs.EOF Then
        lblPruefInfo.Caption = "Es liegt kein Prüfergebis vor"
    Else
        'Ergebnis in das Grid schreiben
        lblPruefInfo.Caption = ""
        grdPrfErgebnis.FormatString = "SerienNr \ m³/h |             |             |             |             |             |             |             |             |             |             "
        grdPrfErgebnis.TextArray(1) = rs.getStringValue("PP1_Soll")
        grdPrfErgebnis.TextArray(2) = rs.getStringValue("PP2_Soll")
        grdPrfErgebnis.TextArray(3) = rs.getStringValue("PP3_Soll")
        grdPrfErgebnis.TextArray(4) = rs.getStringValue("PP4_Soll")
        grdPrfErgebnis.TextArray(5) = rs.getStringValue("PP5_Soll")
        grdPrfErgebnis.TextArray(6) = rs.getStringValue("PP6_Soll")
        grdPrfErgebnis.TextArray(7) = rs.getStringValue("PP7_Soll")
        grdPrfErgebnis.TextArray(8) = rs.getStringValue("PP8_Soll")
        grdPrfErgebnis.TextArray(9) = rs.getStringValue("PP9_Soll")
        grdPrfErgebnis.TextArray(10) = rs.getStringValue("PP10_Soll")
        grdPrfErgebnis.TextArray(11) = rs.getStringValue("Seriennr")
        
        If Not rs.isFieldNull("PP1_Fehler") Then
            grdPrfErgebnis.TextArray(12) = Round(rs.getDoubleValue("PP1_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP2_Fehler") Then
            grdPrfErgebnis.TextArray(13) = Round(rs.getDoubleValue("PP2_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP3_Fehler") Then
            grdPrfErgebnis.TextArray(14) = Round(rs.getDoubleValue("PP3_Fehler"), 2)
        End If
         
        If Not rs.isFieldNull("PP4_Fehler") Then
            grdPrfErgebnis.TextArray(15) = Round(rs.getDoubleValue("PP4_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP5_Fehler") Then
            grdPrfErgebnis.TextArray(16) = Round(rs.getDoubleValue("PP5_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP6_Fehler") Then
            grdPrfErgebnis.TextArray(17) = Round(rs.getDoubleValue("PP6_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP7_Fehler") Then
            grdPrfErgebnis.TextArray(18) = Round(rs.getDoubleValue("PP7_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP8_Fehler") Then
            grdPrfErgebnis.TextArray(19) = Round(rs.getDoubleValue("PP8_Fehler"), 2)
        End If
         
        If Not rs.isFieldNull("PP9_Fehler") Then
            grdPrfErgebnis.TextArray(20) = Round(rs.getDoubleValue("PP9_Fehler"), 2)
        End If
        
        If Not rs.isFieldNull("PP10_Fehler") Then
            grdPrfErgebnis.TextArray(21) = Round(rs.getDoubleValue("PP10_Fehler"), 2)
        End If
    End If
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        blnAbbruch = True
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    MsgBox KeyAscii
End Sub

Private Sub grdSeriennr_DblClick()
    cmdOk_Click
End Sub

Private Sub cmdCancel_Click()
    sSerienNr = ""
    Unload Me
End Sub

Private Sub cmdOk_Click()
    blnAbbruch = True
    
    DoEvents

    grdSeriennr.col = 1
    sSerienNr = grdSeriennr.text
    Unload Me
End Sub

Private Sub cmdSuchen_Click()
    Call suche
    
    If g_lngSerienNr = 0 Then
        ' wenn nicht nach der SerienNr aus dem SerienNrFeld gesucht werden soll:
        ' Letzten genutzten Auftrag speichern
        g_App.Settings.LetzterAuftrag = Val(txtAuftrag.text)
        g_App.Settings.LetztePosition = Val(txtPosition.text)
    End If

End Sub

Private Sub suche()
    blnAbbruch = False
    
    DoEvents
    
    On Error Resume Next
    ' geändert in vielen Punkten ab 25.07.02 Pfeiffer
    '################################################
    ' Letzte Änderung am 05.08.02 Pfeiffer
    Dim rs As CRecordset
    Dim sSQL As String
    Dim sOffen As Integer
    Dim i As Integer
    'Dim Offset As Integer
    'Dim Erste As Boolean
    Dim idx As Integer
    Dim Merker As Boolean
    Dim sSerienNr() As Variant
    Dim sWiederhol() As Variant
    Dim sKndSeriennr() As Variant
    
    Dim AnzahlSeriennr As Integer
    Dim BereichAbPosition As Integer
    
    Dim AnzahlZaehlerNichtErfolgreich As Long
    
    lblMeldung.Caption = ""
    grdPrfErgebnis.Clear
    grdSeriennr.Rows = 1
    grdSeriennr.Clear
    grdSeriennr.FormatString = " Nr. |  SerienNr  |   Knd-SerienNr      "
    cmdSuchen.Enabled = False
    Screen.MousePointer = vbHourglass
        
    ' Auftrag vorhanden ?
        'sSQL = "SELECT distinct AuftragPositionSerienNr.AuftragNr, AuftragPositionSerienNr.PositionNr, " _
        '& " AuftragPositionSerienNr.SerienNr,MAX(AuftragPositionSerienNr.StatusFertigung) AS [LWStatusFertigung] " _
        '& " FROM AuftragPositionSerienNr" _
        '& " GROUP BY AuftragPositionSerienNr.AuftragNr, AuftragPositionSerienNr.PositionNr, " _
        '& " AuftragPositionSerienNr.SerienNr " _
        '& " HAVING ((AuftragPositionSerienNr.AuftragNr)=" & lngAuftrag & ")" _
        '& " AND ((AuftragPositionSerienNr.PositionNr)= " & lngPosition & ");"

        sSQL = "SELECT distinct " _
        & " AuftragPositionSerienNr.SerienNr, AuftragPositionSerienNr.KundeneigeneSerienNr ,MAX(AuftragPositionSerienNr.Wiederholungen) AS [MaxWiederhol] " _
        & " FROM AuftragPositionSerienNr" _
        & " GROUP BY AuftragPositionSerienNr.KundeneigeneSerienNr , AuftragPositionSerienNr.AuftragNr, AuftragPositionSerienNr.PositionNr, " _
        & " AuftragPositionSerienNr.SerienNr " _
        & " HAVING ((AuftragPositionSerienNr.AuftragNr)=" & lngAuftrag & ") "
        sSQL = sSQL & " AND ((AuftragPositionSerienNr.PositionNr)= " & lngPosition & ") "
        sSQL = sSQL & " ORDER BY AuftragPositionSerienNr.SerienNr "
        
    Debug.Print sSQL
    Set rs = New CRecordset
    rs.openRS sSQL, True
    
    'Kein Auftrag gefunden
    If rs.EOF Then
        MsgBox "Auftrag " & lngAuftrag & "/" & lngPosition & " nicht gefunden"
        Screen.MousePointer = vbNormal
        Exit Sub
    Else
        'Wenn Auftrag gefunden, dann Liste füllen
        ReDim sSerienNr(rs.RecordCount) As Variant
        ReDim sWiederhol(rs.RecordCount) As Variant
        ReDim sKndSeriennr(rs.RecordCount) As Variant
        
        AnzahlSeriennr = rs.RecordCount
        Do While i < rs.RecordCount
            sSerienNr(i) = rs.getStringValue("Seriennr")
            sWiederhol(i) = rs.getStringValue("MaxWiederhol")
            sKndSeriennr(i) = rs.getStringValue("KundeneigeneSeriennr")
            i = i + 1
            rs.MoveNext
        Loop
        
       
        'grdSeriennr.TopRow = 0
      
        
        sOffen = rs.RecordCount
        
        grdSeriennr.Enabled = False
        
        grdSeriennr.ColWidth(1) = 990
        grdSeriennr.ColWidth(2) = grdSeriennr.Width - grdSeriennr.ColWidth(0) - grdSeriennr.ColWidth(1) - 400
        grdSeriennr.CellAlignment = vbLeftJustify
                
        For i = 1 To AnzahlSeriennr
             sSQL = "SELECT distinct " _
            & " AuftragPositionSerienNr.StatusFertigung as LWStatusFertigung," _
            & " FabNr" _
            & " FROM AuftragPositionSerienNr" _
            & " WHERE ((AuftragPositionSerienNr.SerienNr)=" & Str(sSerienNr(i - 1)) & ")" _
            & " AND ((AuftragPositionSerienNr.Wiederholungen)= " & Str(sWiederhol(i - 1)) & ");"
            Set rs = New CRecordset
            rs.openRS sSQL, True
            Debug.Print sSQL
            
            DoEvents
            If blnAbbruch = True Then
                Exit For
            End If
            
            grdSeriennr.AddItem i & " " & vbTab & FormatSerienNr(sSerienNr(i - 1)) & "  " & vbTab & sKndSeriennr(i - 1) ', i
            
            If rs.getLongValue("FabNr") > 0 Then
                StrikeThroughSetCol i, False, vbRed
                
                Debug.Print "FabNr " & rs.getLongValue("FabNr") & " für Seriennr " & Str(sSerienNr(i - 1))
            End If
            
            'Wenn bereits mindestens erfolgreich geprüft (30)
            If rs.getStringValue("LWStatusFertigung") >= 30 Then
                
                StrikeThroughSetCol i, True, vbRed
                
'                grdSeriennr.COL = 1
'                grdSeriennr.row = i
'                grdSeriennr.CellFontStrikeThrough = True
'                grdSeriennr.CellForeColor = vbRed
                
                sOffen = sOffen - 1
            End If
           
           
           If rs.getStringValue("LWStatusFertigung") < 30 Then
                AnzahlZaehlerNichtErfolgreich = AnzahlZaehlerNichtErfolgreich + 1
           End If
           
           'Wenn bereits mindestens geprüft mit Gerenzwert überschritten (25)
           If rs.getStringValue("LWStatusFertigung") = 25 Then
                StrikeThroughSetCol i, False, vbBlue
           
'                grdSeriennr.COL = 1
'                grdSeriennr.row = i
'                grdSeriennr.CellFontStrikeThrough = False
'                grdSeriennr.CellForeColor = vbBlue
           End If
        
            'Wenn bereits Seriennummern ausgewählt worden sind
            For idx = 1 To 10
                
                'Debug.Print Trim(g_Seriennr(idx)) & " =?= " & Str(sSeriennr(i - 1))
                
                
                If Val(Trim(g_Seriennr(idx))) = Val(Trim(Str(sSerienNr(i - 1)))) Then
                
                    StrikeThroughSetCol i, False, vbBlack, vbGreen
                    'lblSensusSerNr.Caption = g_Seriennr(idx)
                    
'                    grdSeriennr.COL = 1
'                    grdSeriennr.row = i
                    BereichAbPosition = i
'                    grdSeriennr.CellFontStrikeThrough = False
'                    grdSeriennr.CellBackColor = &HC0FFC0
                    Merker = True
                End If
            Next
        Next
            

        Debug.Print "letzte ausgewählte Zeile: " & BereichAbPosition
        grdSeriennr.Enabled = True
        cmdOK.Enabled = True
        cmdOK.Default = True
        cmdSuchen.Enabled = False
    End If
   
    'restlichen Zeilen löschen
    i = 1
    Do While AnzahlSeriennr < grdSeriennr.Rows - 1
        grdSeriennr.RemoveItem (grdSeriennr.Rows)
    Loop
    
    
    ' Die erste freie Seriennumer markieren
    If grdSeriennr.Rows > 1 Then
        grdSeriennr.row = 1
    End If
    grdSeriennr.col = 1
    
    If BereichAbPosition > 0 Then
        grdSeriennr.row = BereichAbPosition
        If BereichAbPosition >= grdSeriennr.Rows - 1 Then
            'grdSeriennr.Row = 1
        End If
    End If
    
    ' für alle Rows
    Do While grdSeriennr.row < grdSeriennr.Rows - 1
        'und an dritte sichbare Stelle bringen
        If grdSeriennr.CellBackColor = 0 And grdSeriennr.CellForeColor = 0 Then
            If grdSeriennr.Rows > 10 And grdSeriennr.row > 10 Then
                grdSeriennr.TopRow = grdSeriennr.row - 6
            Else
                grdSeriennr.TopRow = 1
            End If
            grdSeriennr.SetFocus
           
            ZeileAuswaehlen grdSeriennr.row
            
            ' Pfeile aktivieren,deaktivieren
            grdSeriennr_Scroll
            Exit Do
        End If
        'grdSeriennr.CellFontBold = False
        grdSeriennr.row = grdSeriennr.row + 1
        If grdSeriennr.CellBackColor = 0 Then
            grdSeriennr.SetFocus
            'grdSeriennr.CellFontBold = True
        End If
    Loop

'    If grdSeriennr.Row = grdSeriennr.Rows - 1 Then
'        Debug.Print "Ende erreicht"
'    End If
    
    'if grdSeriennr.Row
    ' ALT auskommentiert am 30.07.02 Pfeiffer
    ' sSQL = "SELECT SerienNr from AuftragPositionSerienNr where AuftragNr=" & lngAuftrag & " and PositionNr  = " & lngPosition & " ORDER BY SerienNr;"
    
    ' Ermitteln der Auftragsdaten
    sSQL = "SELECT FertigungsauftragNr ,Name, Typ, Menge, " _
    & "VersandDatum, Nennweite " _
    & "FROM Kunde INNER JOIN (Auftrag INNER JOIN (Identnr INNER JOIN AuftragPosition ON " _
    & "Identnr.IdentNr = AuftragPosition.IdentNr) ON " _
    & "Auftrag.AuftragNr = AuftragPosition.AuftragNr) ON Kunde.KundenNr = Auftrag.KundenNr " _
    & "WHERE ((AuftragPosition.AuftragNr)=" & lngAuftrag & ")" _
    & " AND ((AuftragPosition.PositionNr)= " & lngPosition & ");"

    Set rs = New CRecordset
    ' Anzeigen von Kurzinformationen eines Auftrages
    rs.openRS sSQL, True
    If rs.EOF Then
      lblKunde.Caption = "Keinen aktiven Auftrag gefunden"
    Else
      lblKunde.Caption = "Auftrag: " & lngAuftrag & "/" & lngPosition & Chr(10) & "Kunde: " & rs.getStringValue("Name") & Chr(10) & _
      "Typ: " & rs.getStringValue("Typ") & ", DN " & rs.getStringValue("Nennweite") & Chr(10) & "Menge: " & sOffen & " von " & _
      rs.getStringValue("Menge") & " offen " & Chr(10) & "Versand am: " & rs.getStringValue("VersandDatum")
      
      txtFertigungsAuftragNr.text = rs.getLongValue("FertigungsauftragNr")
    End If
    
    chkSensusSerNrAnzeigen_Click
    
    chkerfolgreichGepruefteAnzeigen_Click
    
    AutoSpaltenBreite grdSeriennr, lblAutosize
    grdSeriennr.ColWidth(2) = grdSeriennr.ColWidth(2) * 1.2

    Screen.MousePointer = vbNormal
    grdSeriennr.RowSel = grdSeriennr.row
    grdSeriennr.col = 0
    grdSeriennr.ColSel = 2
    grdSeriennr.SetFocus
    
    
    If sOffen = 0 Then
        lblMeldung.Caption = "Alle Zähler dieser Auftragposition " & vbCrLf
        If Val(txtFertigungsAuftragNr.text) > 0 Then
            lblMeldung.Caption = lblMeldung.Caption & "FANr: " & txtFertigungsAuftragNr.text & vbCrLf
        End If
        If Val(txtAuftrag.text) > 0 Then
            lblMeldung.Caption = lblMeldung.Caption & "Auftrag: " & txtAuftrag.text & " / " & txtPosition.text & vbCrLf
        End If
        lblMeldung.Caption = lblMeldung.Caption & " sind erfolgreich geprüft!"
    End If
End Sub



Private Sub grdSeriennr_Scroll()
    If grdSeriennr.Rows < 12 Then 'keine Linien
        Line1.Visible = False
        Line2.Visible = False
        Line3.Visible = False
        Line4.Visible = False
        Line5.Visible = False
        Line6.Visible = False
    Else
        Line1.Visible = True
        Line2.Visible = True
        Line3.Visible = True
        Line4.Visible = True
        Line5.Visible = True
        Line6.Visible = True
    End If
End Sub




Private Sub grdSeriennr_SelChange()
        
    ZeileAuswaehlen grdSeriennr.row
End Sub








Private Sub txtFertigungsAuftragNr_KeyPress(KeyAscii As Integer)
    Debug.Print KeyAscii
    cmdNachFertAuftragSuchen.Enabled = True
    cmdNachFertAuftragSuchen.Default = True
    txtFertigungsAuftragNr.BackColor = vbWhite
    
    If KeyAscii = 13 Then
        NachFertAuftragSuchen txtFertigungsAuftragNr.text
        
    End If
End Sub

Private Sub txtKundeneigeneSerienNr_Change()
    txtKundeneigeneSerienNr.BackColor = vbWhite
    cmdNachKundeneigeneSerienNrSuchen.Default = True
End Sub

Private Sub txtPosition_Change()
    Call EingabenPruefen
End Sub

Private Sub txtPosition_GotFocus()
    txtPosition.SelStart = 0  'todo Text markieren
    txtPosition.SelLength = Len(txtPosition.text)
End Sub

Private Sub txtAuftrag_Change()
    txtPosition.text = ""
    Call EingabenPruefen
End Sub

Private Sub txtAuftrag_GotFocus()
    txtAuftrag.SelStart = 0  'todo Text markieren
    txtAuftrag.SelLength = Len(txtAuftrag.text)
    
End Sub

Private Sub EingabenPruefen()
   'Neu eingefügt Andreas Pfeiffer 28.02.2005
   On Error Resume Next
   If txtAuftrag.text <> "" And txtPosition.text <> "" Then
        cmdSuchen.Enabled = True
        cmdSuchen.Default = True
        lngAuftrag = CLng(txtAuftrag)
        lngPosition = CLng(txtPosition)
    Else
        cmdSuchen.Enabled = False
        cmdSuchen.Default = False
    End If
End Sub

Private Sub txtAuftrag_KeyPress(KeyAscii As Integer)
On Error Resume Next
    Select Case KeyAscii
    Case 8 ' backspace
    Case 9
    Case 13 'return
        txtPosition.SetFocus
        Exit Sub
    Case 22 ' ctrl V
    Case 3 ' ctrl C
    Case Else
        If Not IsNumeric(Chr(KeyAscii)) Then
       
            KeyAscii = 0
        End If
    End Select
End Sub

Private Sub txtPosition_KeyPress(KeyAscii As Integer)
On Error Resume Next

    Select Case KeyAscii
    
    'Neu eingefügt Andreas Pfeiffer 28.02.2005
    Case 45 ' Minuszeichen
    
    Case 8 ' backspace
    Case 13 ' return
        cmdSuchen.SetFocus
        cmdSuchen_Click
        Exit Sub
    Case 22 ' ctrl V
    Case 3 ' ctrl c
    Case Else
        If Not IsNumeric(Chr(KeyAscii)) Then
          
            KeyAscii = 0
        End If
    End Select
End Sub


Private Function NachFertAuftragSuchen(strFertAuftragNr As String) As Boolean
    Dim strSQL As String
    Dim rs As CRecordset
    
    strSQL = "SELECT * from AlleAuftragPositionen  WHERE FertigungsauftragNr = " & Val(strFertAuftragNr)
    
    Set rs = New CRecordset
    rs.openRS strSQL, True
    
    txtFertigungsAuftragNr.SelStart = 0
    txtFertigungsAuftragNr.SelLength = Len(txtFertigungsAuftragNr.text)
    
    
    If Not rs.EOF Then
        txtAuftrag.text = rs.getLongValue("AuftragNr")
        txtPosition.text = rs.getLongValue("PositionNr")
        NachFertAuftragSuchen = True
        cmdSuchen_Click
    Else
        Debug.Print "kenn ich nich"
        txtFertigungsAuftragNr.BackColor = vbRed
        txtFertigungsAuftragNr.SetFocus
    End If
    
End Function

Private Function NachKundeneigeneSerienNrSuchen(strKundeneigeneSerienNr As String)
    Dim strSQL As String
    Dim rs As CRecordset
    
    strSQL = "SELECT * from AuftragPositionSerienNr WHERE KundeneigeneSerienNr = '" & Replace(strKundeneigeneSerienNr, "'", "''") & "'"
    
    Set rs = New CRecordset
    rs.openRS strSQL, True
    
    txtFertigungsAuftragNr.SelStart = 0
    txtFertigungsAuftragNr.SelLength = Len(txtFertigungsAuftragNr.text)
    
    If Not rs.EOF Then
        txtAuftrag.text = rs.getLongValue("AuftragNr")
        txtPosition.text = rs.getLongValue("PositionNr")
        cmdSuchen_Click
        NachKundeneigeneSerienNrSuchen = True
        Exit Function
    Else
        If Val(strKundeneigeneSerienNr) > 0 Then
            strSQL = "SELECT * from AuftragPositionSerienNr WHERE SerienNr = " & Val(strKundeneigeneSerienNr)
            Set rs = New CRecordset
            rs.openRS strSQL, True
            If Not rs.EOF Then
                txtAuftrag.text = rs.getLongValue("AuftragNr")
                txtPosition.text = rs.getLongValue("PositionNr")
                cmdSuchen_Click
                NachKundeneigeneSerienNrSuchen = True
                Exit Function
            End If
        End If
    End If
    
    strSQL = "SELECT * from eRegister where "
    
End Function



Private Sub VersteckeSensusSerienNr(blnVerstecke As Boolean)
    Dim lngRow As Long
    Dim lngSelRow As Long
    
    lngRow = grdSeriennr.row
    lngSelRow = grdSeriennr.RowSel
    
    If grdSeriennr.Cols < 3 Then
        Exit Sub
    End If
    
    Dim i As Integer
    Dim blnKundenEigeneIstGefuellt As Boolean

    If blnVerstecke Then
        blnKundenEigeneIstGefuellt = False
        For i = 1 To grdSeriennr.Rows - 1
            grdSeriennr.row = i
            grdSeriennr.col = 2
            If grdSeriennr.text <> "" Then
                blnKundenEigeneIstGefuellt = True
            End If
        Next
        
        If blnKundenEigeneIstGefuellt = True Then
            grdSeriennr.ColWidth(1) = 0
        End If
    Else
        AutoSpaltenBreite grdSeriennr, lblAutosize
    End If
    
    grdSeriennr.row = lngRow
    grdSeriennr.RowSel = lngSelRow
    
End Sub


Private Sub StrikeThroughSetCol(lngRow As Variant, Optional blnStrikekout As Variant, Optional lngForeColor As Variant, Optional lngColorBack As Variant, Optional blnBold As Variant)
On Error GoTo Errorhandler
    Dim lngCol  As Long
    For lngCol = 1 To grdSeriennr.Cols - 1
    
        grdSeriennr.row = lngRow
        grdSeriennr.col = lngCol
        
        If Not IsMissing(blnStrikekout) Then
            If blnStrikekout Then
                grdSeriennr.CellFontStrikeThrough = True
            Else
                grdSeriennr.CellFontStrikeThrough = False
            End If
        End If
        
        If Not IsMissing(lngForeColor) Then
            grdSeriennr.CellForeColor = lngForeColor
        End If
        
        If Not IsMissing(lngColorBack) Then
            grdSeriennr.CellBackColor = lngColorBack
        End If
        
        If Not IsMissing(blnBold) Then
            grdSeriennr.CellFontBold = blnBold
        End If
    Next
    Exit Sub
Errorhandler:
    LogIntoDB "Fehler " & Err.Number & " in StrikeThroughSetCol() " & Err.Description

End Sub


Private Sub ZeileAuswaehlen(lngZeile As Long)

    On Error Resume Next  ' 27.5.2013  Ab Einbauplatz 7 trat hier ein Fehler "Ungültiger Spaltenwert" auf, wahrscheinlich in Fkt. Prueferergebnisanzeigen()
    
    If m_lngLastSelectedRow > -1 And m_lngLastSelectedRow < grdSeriennr.Rows Then
        StrikeThroughSetCol m_lngLastSelectedRow, , , vbWhite, False
    End If
    
    grdSeriennr.RowSel = lngZeile
    grdSeriennr.row = lngZeile
    
    Prueferergebnisanzeigen
    

    StrikeThroughSetCol lngZeile, , , 0, True
    m_lngLastSelectedRow = grdSeriennr.RowSel
    
    
End Sub