1250 lines
40 KiB
Plaintext
1250 lines
40 KiB
Plaintext
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
|