1585 lines
53 KiB
Plaintext
1585 lines
53 KiB
Plaintext
VERSION 5.00
|
|
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmRuecklaeuferanalyse
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "Rückläuferanaylse QA_M_037"
|
|
ClientHeight = 10230
|
|
ClientLeft = 45
|
|
ClientTop = 330
|
|
ClientWidth = 12990
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 10230
|
|
ScaleWidth = 12990
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.Frame Frame1
|
|
Height = 3075
|
|
Left = 60
|
|
TabIndex = 24
|
|
Top = 1320
|
|
Width = 4395
|
|
Begin VB.Label Label8
|
|
Alignment = 1 'Rechts
|
|
Caption = "Geräte-Nr.:"
|
|
Height = 195
|
|
Left = 90
|
|
TabIndex = 47
|
|
Top = 2670
|
|
Width = 915
|
|
End
|
|
Begin VB.Label lblFabNr
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 46
|
|
Top = 2640
|
|
Width = 1395
|
|
End
|
|
Begin VB.Label lblDatum
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 44
|
|
Top = 600
|
|
Width = 2355
|
|
End
|
|
Begin VB.Label Label7
|
|
Alignment = 1 'Rechts
|
|
Caption = "Datum:"
|
|
Height = 195
|
|
Left = 300
|
|
TabIndex = 43
|
|
Top = 600
|
|
Width = 615
|
|
End
|
|
Begin VB.Label Label4
|
|
Alignment = 1 'Rechts
|
|
Caption = "Prüfgang Datum"
|
|
Height = 195
|
|
Left = 60
|
|
TabIndex = 40
|
|
Top = 1500
|
|
Width = 1215
|
|
End
|
|
Begin VB.Label lblPruefgangDatum
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 39
|
|
Top = 1500
|
|
Width = 2775
|
|
End
|
|
Begin VB.Label Label21
|
|
Caption = "Prüfer:"
|
|
Height = 255
|
|
Left = 420
|
|
TabIndex = 37
|
|
Top = 240
|
|
Width = 615
|
|
End
|
|
Begin VB.Label lblPruefer
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 36
|
|
Top = 240
|
|
Width = 2355
|
|
End
|
|
Begin VB.Label lblStatus
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 34
|
|
Top = 2280
|
|
Width = 2775
|
|
End
|
|
Begin VB.Label Label24
|
|
Caption = "Status:"
|
|
Height = 255
|
|
Left = 420
|
|
TabIndex = 33
|
|
Top = 2280
|
|
Width = 495
|
|
End
|
|
Begin VB.Label lblPruefgang
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 32
|
|
Top = 1140
|
|
Width = 1395
|
|
End
|
|
Begin VB.Label Label19
|
|
Caption = "Prüfgang:"
|
|
Height = 195
|
|
Left = 420
|
|
TabIndex = 31
|
|
Top = 1140
|
|
Width = 735
|
|
End
|
|
Begin VB.Label Label12
|
|
Caption = "Wdh."
|
|
Height = 255
|
|
Left = 3060
|
|
TabIndex = 30
|
|
Top = 1200
|
|
Width = 435
|
|
End
|
|
Begin VB.Label lblWiederholung
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 3600
|
|
TabIndex = 29
|
|
Top = 1140
|
|
Width = 555
|
|
End
|
|
Begin VB.Label lblPruefstation
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1380
|
|
TabIndex = 28
|
|
Top = 1860
|
|
Width = 795
|
|
End
|
|
Begin VB.Label Label9
|
|
Caption = "Prüfstation:"
|
|
Height = 195
|
|
Left = 420
|
|
TabIndex = 27
|
|
Top = 1860
|
|
Width = 855
|
|
End
|
|
Begin VB.Label Label10
|
|
Caption = "Einbauplatz: "
|
|
Height = 255
|
|
Left = 2640
|
|
TabIndex = 26
|
|
Top = 1920
|
|
Width = 915
|
|
End
|
|
Begin VB.Label lblEinbauplatz
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 3600
|
|
TabIndex = 25
|
|
Top = 1860
|
|
Width = 555
|
|
End
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 375
|
|
Left = 0
|
|
TabIndex = 23
|
|
Top = 9855
|
|
Width = 12990
|
|
_ExtentX = 22913
|
|
_ExtentY = 661
|
|
Style = 1
|
|
_Version = 393216
|
|
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
|
|
NumPanels = 1
|
|
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin VB.Frame fameHistorie
|
|
Caption = "Rückläufer Historie"
|
|
Height = 4620
|
|
Left = 60
|
|
TabIndex = 21
|
|
Top = 4410
|
|
Width = 4395
|
|
Begin VB.CommandButton cmdPrint
|
|
Caption = "Drucken"
|
|
Height = 375
|
|
Left = 210
|
|
TabIndex = 45
|
|
Top = 2520
|
|
Width = 1275
|
|
End
|
|
Begin VB.ListBox lstHistorie
|
|
Height = 1815
|
|
Left = 150
|
|
TabIndex = 22
|
|
Top = 270
|
|
Width = 4035
|
|
End
|
|
Begin VB.Label lblGesZeit
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 3390
|
|
TabIndex = 42
|
|
Top = 2580
|
|
Width = 675
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Ges. Zeitaufwand"
|
|
Height = 255
|
|
Left = 2010
|
|
TabIndex = 41
|
|
Top = 2640
|
|
Width = 1515
|
|
End
|
|
End
|
|
Begin VB.Frame frameOK
|
|
Height = 825
|
|
Left = -15
|
|
TabIndex = 19
|
|
Top = 9030
|
|
Width = 12960
|
|
Begin VB.CommandButton cmdBeenden
|
|
Caption = "Schließen"
|
|
Height = 375
|
|
Left = 10830
|
|
TabIndex = 20
|
|
Top = 315
|
|
Width = 1965
|
|
End
|
|
End
|
|
Begin VB.Frame fmAusfall
|
|
Caption = "Ausfall "
|
|
Height = 7680
|
|
Left = 4515
|
|
TabIndex = 9
|
|
Top = 1320
|
|
Width = 8430
|
|
Begin VB.ComboBox cmbBefund
|
|
Height = 315
|
|
Left = 2295
|
|
Style = 2 'Dropdown-Liste
|
|
TabIndex = 51
|
|
Top = 6480
|
|
Width = 4245
|
|
End
|
|
Begin VB.ListBox lstAusfallgrund
|
|
Height = 1410
|
|
Left = 240
|
|
Style = 1 'Kontrollkästchen
|
|
TabIndex = 48
|
|
Top = 1680
|
|
Width = 7995
|
|
End
|
|
Begin VB.CommandButton cmdSave
|
|
Caption = "Speichern"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 525
|
|
Left = 6180
|
|
TabIndex = 38
|
|
Top = 7005
|
|
Width = 2100
|
|
End
|
|
Begin VB.TextBox txtZeitaufwand
|
|
Alignment = 1 'Rechts
|
|
Height = 315
|
|
Left = 1290
|
|
TabIndex = 18
|
|
Top = 6975
|
|
Width = 555
|
|
End
|
|
Begin VB.TextBox txtReparaturmassnahme
|
|
Height = 1125
|
|
Left = 180
|
|
MultiLine = -1 'True
|
|
ScrollBars = 2 'Vertikal
|
|
TabIndex = 16
|
|
Top = 5265
|
|
Width = 8025
|
|
End
|
|
Begin VB.TextBox txtAusfallgrund
|
|
Height = 1395
|
|
Left = 255
|
|
MultiLine = -1 'True
|
|
ScrollBars = 2 'Vertikal
|
|
TabIndex = 13
|
|
Top = 3570
|
|
Width = 8025
|
|
End
|
|
Begin MSFlexGridLib.MSFlexGrid msfgPruefpunkte
|
|
Height = 915
|
|
Left = 240
|
|
TabIndex = 10
|
|
Top = 450
|
|
Width = 8085
|
|
_ExtentX = 14261
|
|
_ExtentY = 1614
|
|
_Version = 393216
|
|
End
|
|
Begin VB.Label Label13
|
|
Caption = "Maßnahme erfolgreich:"
|
|
Height = 255
|
|
Left = 375
|
|
TabIndex = 52
|
|
Top = 6525
|
|
Width = 2070
|
|
End
|
|
Begin VB.Label Label20
|
|
Caption = "min"
|
|
Height = 255
|
|
Left = 1950
|
|
TabIndex = 35
|
|
Top = 7005
|
|
Width = 375
|
|
End
|
|
Begin VB.Label Label17
|
|
Caption = "Zeitaufwand"
|
|
Height = 255
|
|
Left = 210
|
|
TabIndex = 17
|
|
Top = 7035
|
|
Width = 1455
|
|
End
|
|
Begin VB.Label Label16
|
|
Caption = "Reparatur-Massnahmen"
|
|
Height = 285
|
|
Left = 195
|
|
TabIndex = 15
|
|
Top = 5055
|
|
Width = 4695
|
|
End
|
|
Begin VB.Label Label15
|
|
Caption = "sonstige Ausfallgründe"
|
|
Height = 195
|
|
Left = 255
|
|
TabIndex = 14
|
|
Top = 3270
|
|
Width = 4035
|
|
End
|
|
Begin VB.Label Label14
|
|
Caption = "Ergebnis der letzten Prüfung"
|
|
Height = 255
|
|
Left = 240
|
|
TabIndex = 12
|
|
Top = 210
|
|
Width = 2115
|
|
End
|
|
Begin VB.Label lblAusfallgrund
|
|
Caption = "Ausfallgründe"
|
|
Height = 195
|
|
Left = 240
|
|
TabIndex = 11
|
|
Top = 1380
|
|
Width = 2175
|
|
End
|
|
End
|
|
Begin VB.Frame frameAuftragsdaten
|
|
Caption = "Auftragsdaten"
|
|
Height = 1275
|
|
Left = 60
|
|
TabIndex = 0
|
|
Top = 0
|
|
Width = 12885
|
|
Begin VB.Label lblKundeneigeneSNr
|
|
Alignment = 1 'Rechts
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 5100
|
|
TabIndex = 50
|
|
Top = 810
|
|
Width = 2355
|
|
End
|
|
Begin VB.Label Label11
|
|
Caption = "Kundeneigene SNr.:"
|
|
Height = 255
|
|
Left = 3300
|
|
TabIndex = 49
|
|
Top = 840
|
|
Width = 1605
|
|
End
|
|
Begin VB.Label lblBezeichnung
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 4440
|
|
TabIndex = 8
|
|
Top = 360
|
|
Width = 3015
|
|
End
|
|
Begin VB.Label Label6
|
|
Alignment = 1 'Rechts
|
|
Caption = "Bezeichnung:"
|
|
Height = 195
|
|
Left = 3240
|
|
TabIndex = 7
|
|
Top = 360
|
|
Width = 1035
|
|
End
|
|
Begin VB.Label lblSerienNr
|
|
Alignment = 2 'Zentriert
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1590
|
|
TabIndex = 6
|
|
Top = 780
|
|
Width = 1395
|
|
End
|
|
Begin VB.Label Label5
|
|
Caption = "SerienNr.:"
|
|
Height = 255
|
|
Left = 720
|
|
TabIndex = 5
|
|
Top = 780
|
|
Width = 795
|
|
End
|
|
Begin VB.Label lblKunde
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 8430
|
|
TabIndex = 4
|
|
Top = 390
|
|
Width = 3015
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "Kunde:"
|
|
Height = 195
|
|
Left = 7710
|
|
TabIndex = 3
|
|
Top = 390
|
|
Width = 555
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "Auftrag / Position:"
|
|
Height = 255
|
|
Left = 180
|
|
TabIndex = 2
|
|
Top = 360
|
|
Width = 1275
|
|
End
|
|
Begin VB.Label lblAuftragPosNr
|
|
Alignment = 2 'Zentriert
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 255
|
|
Left = 1560
|
|
TabIndex = 1
|
|
Top = 360
|
|
Width = 1395
|
|
End
|
|
End
|
|
Begin VB.Image ImgLogo
|
|
Height = 2250
|
|
Left = 705
|
|
Picture = "frmRuecklaeuferanalyse.frx":0000
|
|
Stretch = -1 'True
|
|
Top = 6225
|
|
Visible = 0 'False
|
|
Width = 8100
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmRuecklaeuferanalyse"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Public m_Pruefgang As CPruefgang
|
|
Public m_Pruefzaehler As CPruefzaehler
|
|
Public m_EinbauplatzNr As Integer
|
|
|
|
' Daten zu Beginn
|
|
Dim m_objAuftrag As CAuftrag
|
|
Dim m_objAuftragPosition As CAuftragPosition
|
|
Dim m_objIdentNr As CIdentNr
|
|
Dim m_objAuftragPositionSerienNr As CAuftragPositionSerienNr
|
|
|
|
Dim m_intWiederholungen As Integer
|
|
Dim m_strStatus As String
|
|
Dim mcol_IDs As Collection
|
|
|
|
|
|
Const NEU = "(neu)"
|
|
Const TXT_BITTEAUSWAEHLEN = "(Bitte auswählen!)"
|
|
Const TXT_ERFOLGREICH = "Zähler erfolgreich geprüft"
|
|
Const TXT_ERNEUTAUSGEFALLEN = "Zähler erneut ausgefallen"
|
|
|
|
Private m_lngID As Long
|
|
|
|
Private mdblLinkerRand As Double
|
|
Private mdblRechterRand As Double
|
|
Private mdblObererRand As Double
|
|
Private mdblUntererRand As Double
|
|
Private mdblLinie1top As Double
|
|
Private mdblCurrentY As Double
|
|
Private mblnIstNeuerEintrag As Boolean
|
|
|
|
|
|
Private Sub cmbBefund_Click()
|
|
Datengeaendert
|
|
End Sub
|
|
|
|
Private Sub cmdBeenden_Click()
|
|
Dim lngReturn As Long
|
|
|
|
If cmdSave.Enabled = True Then
|
|
lngReturn = MsgBox("Sollen Ihre Änderungen gespeichert werden?", vbYesNoCancel Or vbDefaultButton1 Or vbExclamation, Me.Caption)
|
|
Select Case lngReturn
|
|
Case vbYes
|
|
If speichern() = True Then
|
|
Unload Me
|
|
End If
|
|
Case vbNo
|
|
Unload Me
|
|
Case vbCancel
|
|
End Select
|
|
Else
|
|
Unload Me
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub cmdSave_Click()
|
|
cmdSave.Enabled = False
|
|
If speichern() Then
|
|
FilllstHistorie
|
|
End If
|
|
cmdSave.Enabled = False
|
|
End Sub
|
|
|
|
Private Sub Datengeaendert()
|
|
cmdSave.Enabled = True
|
|
End Sub
|
|
|
|
'Private Sub Command1_Click()
|
|
' Dim rs As CRecordset
|
|
' Set rs = New CRecordset
|
|
'
|
|
' Dim rs1 As CRecordset
|
|
' Set rs1 = New CRecordset
|
|
'
|
|
' Dim rs2 As CRecordset
|
|
' Set rs2 = New CRecordset
|
|
'
|
|
' rs.openRS "Ruecklaeuferanalyse", True
|
|
'
|
|
' Do While Not rs.EOF
|
|
' rs1.openRS "select * from Ausfallgruende_bak where Text = '" & rs.getStringValue("Ausfallgrund") & "'"
|
|
'
|
|
' If Not rs1.EOF Then
|
|
' Set rs2 = New CRecordset
|
|
' rs2.openRS "Ruecklaeufer_Ausfallgrund"
|
|
' rs2.addNew
|
|
' Call rs2.setValue("Ruecklaufer_ID", rs.getIntValue("ID"))
|
|
' Call rs2.setValue("Ausfallgrund_ID", rs1.getIntValue("ID"))
|
|
' rs2.update
|
|
' End If
|
|
'
|
|
' rs.MoveNext
|
|
' Loop
|
|
'End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
If m_Pruefzaehler Is Nothing Then
|
|
Unload Me
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
On Error GoTo Errorhandler
|
|
Dim strSearch As String
|
|
|
|
Dim lngSerienNr As Long
|
|
|
|
If m_Pruefzaehler Is Nothing Then
|
|
Set m_Pruefzaehler = New CPruefzaehler
|
|
|
|
strSearch = InputBox("Bitte geben Sie die SerienNr, kundeneigene SNr oder Gerätenummer des Zählers an", "Rückläufer Analyse")
|
|
lngSerienNr = Val(strSearch)
|
|
|
|
If strSearch <> "" Then
|
|
Screen.MousePointer = vbHourglass
|
|
If m_Pruefzaehler.loadForSerienOrFabNummerOrKundeneigene(strSearch) = False Then
|
|
Call MsgBox("Prüfzählerdaten konnten für Nr. " & lngSerienNr & " nicht geladen werden", vbCritical, "Rückläufer Analyse")
|
|
Set m_Pruefzaehler = Nothing
|
|
Screen.MousePointer = vbNormal
|
|
Exit Sub
|
|
End If
|
|
Screen.MousePointer = vbNormal
|
|
Else
|
|
Set m_Pruefzaehler = Nothing
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
|
|
Set m_objAuftrag = m_Pruefzaehler.getAuftrag
|
|
Set m_objAuftragPosition = m_Pruefzaehler.getAuftragPosition
|
|
Set m_objIdentNr = m_objAuftragPosition.getIdentNrObj
|
|
|
|
Set m_objAuftragPositionSerienNr = New CAuftragPositionSerienNr
|
|
m_objAuftragPositionSerienNr.load (m_Pruefzaehler.getSerienNr)
|
|
|
|
' Auftragsdaten
|
|
lblAuftragPosNr.Caption = m_objAuftrag.getNr & " / " & m_objAuftragPosition.getNr
|
|
lblSerienNr.Caption = FormatSerienNr(m_Pruefzaehler.getSerienNr)
|
|
lblKunde.Caption = m_objAuftrag.getKunde.getName & ", " & m_objAuftrag.getKunde.getOrt
|
|
lblBezeichnung.Caption = m_objIdentNr.getTyp & " " & m_objIdentNr.getTypzusatz & " DN" & m_objIdentNr.getNennweite & " " & m_objIdentNr.GetTemperatur & "°C/PN " & m_objIdentNr.getDruck & " (" & m_objAuftragPosition.getAnzeige & ")"
|
|
lblFabNr.Caption = m_Pruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
lblKundeneigeneSNr.Caption = m_Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr
|
|
|
|
Call Fill_lstAusfallgrund
|
|
Call FilllstHistorie
|
|
|
|
Call fillPruefgangFelder
|
|
Call clearPruefpunkteFlexgrid
|
|
|
|
If Not m_Pruefgang Is Nothing Then
|
|
Call fillPrueffehler
|
|
End If
|
|
|
|
cmbBefund.Clear
|
|
cmbBefund.AddItem TXT_BITTEAUSWAEHLEN
|
|
cmbBefund.ListIndex = 0
|
|
cmbBefund.AddItem TXT_ERFOLGREICH
|
|
cmbBefund.AddItem TXT_ERNEUTAUSGEFALLEN
|
|
cmdSave.Enabled = False
|
|
Exit Sub
|
|
Errorhandler:
|
|
MsgBox "Fehler " & Err.Number & " in Rückläuferanalye (Form_Load):" & Err.Description
|
|
End Sub
|
|
|
|
Private Sub clearPruefpunkteFlexgrid()
|
|
msfgPruefpunkte.Clear
|
|
msfgPruefpunkte.Font.Size = 10
|
|
msfgPruefpunkte.Font.Bold = True
|
|
msfgPruefpunkte.col = 0
|
|
msfgPruefpunkte.row = 0
|
|
msfgPruefpunkte.text = "Q [m³/h]"
|
|
msfgPruefpunkte.row = 1
|
|
msfgPruefpunkte.text = "Fehler [%]"
|
|
|
|
End Sub
|
|
|
|
Private Sub fillPrueffehler()
|
|
Dim i As Integer
|
|
Dim rs As CRecordset
|
|
Dim strTemp As String
|
|
Dim Fehler As Double
|
|
Dim Durchfluss As Double
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS "SELECT * FROM Prueffehler where SerienNr=" & m_Pruefzaehler.getSerienNr & " and PruefgangNr= " & m_Pruefgang.PruefgangNr
|
|
If Not rs.EOF Then
|
|
For i = 1 To 10
|
|
strTemp = "PP" & i & "_Fehler"
|
|
If rs.isFieldNull(strTemp) Then Exit For
|
|
msfgPruefpunkte.Cols = i + 1
|
|
|
|
' Fehler vorhanden
|
|
Fehler = Round(rs.getDoubleValue(strTemp), 2)
|
|
Durchfluss = Round(m_Pruefgang.PP_Soll(i), 5)
|
|
msfgPruefpunkte.col = i
|
|
msfgPruefpunkte.row = 0
|
|
|
|
Durchfluss = Round(Durchfluss, 5)
|
|
msfgPruefpunkte.text = CStr(Durchfluss)
|
|
msfgPruefpunkte.row = 1
|
|
msfgPruefpunkte.text = Format(Fehler, "0.0")
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub fillPruefgangFelder()
|
|
Dim Wiederholungen As Long
|
|
|
|
' Pruefgangdaten
|
|
lblPruefer.Caption = g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName
|
|
|
|
If Not m_Pruefgang Is Nothing Then
|
|
If m_Pruefgang.PruefgangNr <> 0 Then
|
|
lblPruefgang.Caption = m_Pruefgang.PruefgangNr
|
|
lblPruefgangDatum.Caption = m_Pruefgang.Datum
|
|
Else
|
|
lblPruefgang.Caption = ""
|
|
lblPruefgangDatum.Caption = ""
|
|
End If
|
|
Else
|
|
lblPruefgang.Caption = ""
|
|
lblPruefgangDatum.Caption = ""
|
|
End If
|
|
lblPruefstation.Caption = g_App.PruefstationNr
|
|
lblEinbauplatz.Caption = m_EinbauplatzNr
|
|
|
|
lblDatum.Caption = Now
|
|
' Auftragsposition
|
|
Wiederholungen = m_objAuftragPositionSerienNr.getWiederholungen
|
|
|
|
lblWiederholung.Caption = Wiederholungen
|
|
|
|
m_strStatus = getStatusFertigung(m_objAuftragPositionSerienNr.getStatusFertigung) & " (" & m_objAuftragPositionSerienNr.getStatusFertigung & ")"
|
|
lblStatus.Caption = m_strStatus
|
|
End Sub
|
|
|
|
Private Sub Fill_lstAusfallgrund()
|
|
lstAusfallgrund.Clear
|
|
Dim rs As CRecordset
|
|
Set rs = New CRecordset
|
|
|
|
rs.openRS "SELECT * from Ausfallgruende where ZurAuswahl = 1 order by Sortorder", True
|
|
Do While Not rs.EOF
|
|
lstAusfallgrund.AddItem rs.getStringValue("ID") & ": " & rs.getStringValue("Text")
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
End Sub
|
|
|
|
Private Sub Select_lstAusfallgrund(RuecklaeuferID As Long)
|
|
Dim rs As CRecordset
|
|
Dim i As Integer
|
|
Dim blnGefunden As Boolean
|
|
Dim rs1 As CRecordset
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS "SELECT Ausfallgrund_ID FROM Ruecklaeufer_Ausfallgrund where Ruecklaufer_ID=" & RuecklaeuferID, True
|
|
Do While Not rs.EOF
|
|
blnGefunden = False
|
|
For i = 0 To lstAusfallgrund.ListCount - 1
|
|
If Val(lstAusfallgrund.List(i)) = rs.getLongValue("Ausfallgrund_ID") Then
|
|
lstAusfallgrund.Selected(i) = True
|
|
blnGefunden = True
|
|
End If
|
|
Next
|
|
If blnGefunden = False Then
|
|
Set rs1 = New CRecordset
|
|
rs1.openRS "SELECT * from Ausfallgruende where ID=" & rs.getLongValue("Ausfallgrund_ID")
|
|
If Not rs1.EOF Then
|
|
lstAusfallgrund.AddItem rs1.getStringValue("ID") & ": " & rs1.getStringValue("Text") & " (Veraltet)"
|
|
Else
|
|
lstAusfallgrund.AddItem "???"
|
|
End If
|
|
|
|
lstAusfallgrund.Selected(lstAusfallgrund.ListCount - 1) = True
|
|
Set rs1 = Nothing
|
|
End If
|
|
rs.MoveNext
|
|
Loop
|
|
End Sub
|
|
|
|
Public Function getStatusFertigung(intStatus As Integer) As String
|
|
Select Case intStatus
|
|
'0=ohne Bearbeitung, 10=Vorfertigung OK, 20=Montage,22=Prüfung abgebrochen,
|
|
'25=Grenzwertüberschreitung Prüfstation, 30=Prüfstation geprüft, 40=dieser Zähler ausgeliefert,45= Lagerauftrag an Lager geliefert, 50=Auftrag ausgeliefert
|
|
Case 0
|
|
getStatusFertigung = "ohne Bearbeitung"
|
|
Case 10
|
|
getStatusFertigung = "Vorfertigung"
|
|
Case 20
|
|
getStatusFertigung = "Montage"
|
|
Case 22
|
|
getStatusFertigung = "Prüfung abgebrochen"
|
|
Case 25
|
|
getStatusFertigung = "Grenzwertüberschreitung"
|
|
Case 30
|
|
getStatusFertigung = "Prüfstation geprüft"
|
|
Case 40
|
|
getStatusFertigung = "Zähler ausgeliefert"
|
|
Case 45
|
|
getStatusFertigung = "Lagerauftrag an Lager geliefert"
|
|
Case 50
|
|
getStatusFertigung = "Auftrag ausgeliefert"
|
|
End Select
|
|
|
|
End Function
|
|
|
|
|
|
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
|
Dim lngReturn As Long
|
|
If UnloadMode = 0 And cmdSave.Enabled = True Then
|
|
' Benutzer hat auf [X] rechts oben geklickt
|
|
lngReturn = MsgBox("Sollen Ihre Änderungen gespeichert werden?", vbYesNoCancel Or vbDefaultButton1 Or vbExclamation, Me.Caption)
|
|
Select Case lngReturn
|
|
Case vbCancel
|
|
Cancel = 1
|
|
Case vbYes
|
|
Call speichern
|
|
Cancel = 0
|
|
Case vbNo
|
|
Cancel = 0
|
|
End Select
|
|
End If
|
|
End Sub
|
|
|
|
Private Function speichern() As Boolean
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim rs As CRecordset
|
|
Dim blnAktualisieren As Boolean
|
|
|
|
Set rs = New CRecordset
|
|
' Pflichtfelder
|
|
If PruefeAufPflichtfelder() = False Then
|
|
speichern = False
|
|
Exit Function
|
|
End If
|
|
|
|
|
|
If m_lngID = 0 Then
|
|
' als Neu abspeichern
|
|
rs.openRS "Ruecklaeuferanalyse", False
|
|
rs.addNew
|
|
|
|
' Felder für die Neuanlage
|
|
|
|
Call rs.setValue("AuftragNr", m_Pruefzaehler.getAuftrag.getNr)
|
|
Call rs.setValue("PositionNr", m_Pruefzaehler.getAuftragPosition.getNr)
|
|
Call rs.setValue("SerienNr", m_Pruefzaehler.getSerienNr)
|
|
Call rs.setValue("Kunde", lblKunde.Caption)
|
|
|
|
If Not m_Pruefgang Is Nothing Then
|
|
If m_Pruefgang.PruefgangNr > 0 Then
|
|
Call rs.setValue("PruefgangNr", m_Pruefgang.PruefgangNr)
|
|
Call rs.setValue("PruefgangDatum", m_Pruefgang.Datum)
|
|
End If
|
|
End If
|
|
|
|
Call rs.setValue("AnlageDatum", Now())
|
|
lblDatum.Caption = Now()
|
|
|
|
Call rs.setValue("Wiederholung", m_objAuftragPositionSerienNr.getWiederholungen)
|
|
|
|
Call rs.setValue("Pruefstation", g_App.PruefstationNr)
|
|
Call rs.setValue("Einbauplatz", m_EinbauplatzNr)
|
|
Call rs.setValue("Pruefer", g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName)
|
|
Call rs.setValue("PrueferNr", g_App.Mitarbeiter.getNr)
|
|
Call rs.setValue("StatusFertigung", m_strStatus)
|
|
|
|
|
|
|
|
Call rs.setValue("Bezeichnung", lblBezeichnung.Caption)
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
'''' Prüfpunkte speichern
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Dim strQ As String
|
|
Dim strFehler As String
|
|
Dim strTrenner As String
|
|
Dim i As Integer
|
|
|
|
strTrenner = ""
|
|
strQ = ""
|
|
strFehler = ""
|
|
|
|
For i = 1 To msfgPruefpunkte.Cols - 1
|
|
msfgPruefpunkte.col = i
|
|
msfgPruefpunkte.row = 0
|
|
strQ = strQ & strTrenner & msfgPruefpunkte.text
|
|
msfgPruefpunkte.row = 1
|
|
strFehler = strFehler & strTrenner & msfgPruefpunkte.text
|
|
strTrenner = "|"
|
|
Next
|
|
|
|
rs.setValue "Pruefpunkte", strQ
|
|
rs.setValue "Fehler", strFehler
|
|
|
|
If lblFabNr.Caption <> "" Then
|
|
Call rs.setValue("FabNr", lblFabNr.Caption)
|
|
End If
|
|
Else
|
|
' aktualisieren
|
|
|
|
rs.openRS "SELECT * from Ruecklaeuferanalyse where ID = " & m_lngID, False
|
|
If rs.EOF Then
|
|
MsgBox "ID " & m_lngID & " existiert nicht. Datensatz kann nicht gespeichert werden."
|
|
speichern = False
|
|
Exit Function
|
|
End If
|
|
blnAktualisieren = True
|
|
End If
|
|
|
|
' hier gibt es diesen Datensatz und kann ggF. gendert werden
|
|
|
|
Call rs.setValue("Zeitaufwand", Val(txtZeitaufwand.text))
|
|
|
|
If Len(txtAusfallgrund.text) > 0 Then
|
|
Call rs.setValue("sonstigerAusfallgrund", txtAusfallgrund.text)
|
|
End If
|
|
|
|
If txtReparaturmassnahme.text <> "" Then
|
|
Call rs.setValue("Befund", txtReparaturmassnahme.text)
|
|
End If
|
|
If cmbBefund.text = TXT_BITTEAUSWAEHLEN Then
|
|
' nichts ausgewählt
|
|
ElseIf cmbBefund.text = TXT_ERFOLGREICH Then
|
|
rs.setValue "ReparaturErfolgreich", True
|
|
ElseIf cmbBefund.text = TXT_ERNEUTAUSGEFALLEN Then
|
|
rs.setValue "ReparaturErfolgreich", False
|
|
End If
|
|
|
|
rs.update
|
|
If m_lngID = 0 Then
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Die ID des eben gespeicherten Rückläufers
|
|
Set rs = New CRecordset
|
|
rs.openRS "SELECT newID = @@IDENTITY", True
|
|
m_lngID = rs.getIntValue("newID")
|
|
End If
|
|
|
|
Call SaveAusfallgruende(m_lngID)
|
|
|
|
TestAufAusfallgrund
|
|
|
|
FilllstHistorie
|
|
speichern = True
|
|
Exit Function
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " beim Speichern des Rückläufers: " & Err.Description
|
|
End Function
|
|
|
|
Private Sub lstAusfallgrund_Click()
|
|
Call Datengeaendert
|
|
End Sub
|
|
|
|
Private Sub lstHistorie_Click()
|
|
AktualisiereVonHistorie lstHistorie.ListIndex
|
|
End Sub
|
|
|
|
|
|
Private Function GetIDFromHistorie() As Long
|
|
Dim strTmp As String
|
|
strTmp = lstHistorie.List(lstHistorie.ListIndex)
|
|
If strTmp = NEU Then
|
|
GetIDFromHistorie = 0
|
|
Else
|
|
GetIDFromHistorie = Val(Split(strTmp, ")")(0))
|
|
End If
|
|
End Function
|
|
|
|
Private Sub AktualisiereVonHistorie(lngIndex As Long)
|
|
Dim strTmp As String
|
|
Dim lngID As Long
|
|
Dim i As Integer
|
|
Dim strDurchfluesse As String
|
|
Dim strFehler As String
|
|
Dim varPP As Variant
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
lngID = GetIDFromHistorie()
|
|
m_lngID = lngID
|
|
|
|
|
|
Call clearPruefpunkteFlexgrid
|
|
mblnIstNeuerEintrag = False
|
|
|
|
If lngID = 0 Then ' Neu
|
|
cmdSave.Enabled = True
|
|
mblnIstNeuerEintrag = True
|
|
txtAusfallgrund.text = ""
|
|
txtReparaturmassnahme.text = ""
|
|
txtZeitaufwand = ""
|
|
|
|
Fill_lstAusfallgrund
|
|
' RH 31.07.2007: nichts auswählen
|
|
'lstAusfallgrund.Selected(0) = True ' erster Eintrag ist selektiert
|
|
|
|
FelderEingabenZulassen
|
|
Call fillPruefgangFelder
|
|
msfgPruefpunkte.Cols = 1
|
|
If Not m_Pruefgang Is Nothing Then
|
|
Call fillPrueffehler
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
FelderSperren
|
|
|
|
strSQL = "SELECT * from Ruecklaeuferanalyse where ID=" & lngID
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
|
|
If Not rs.EOF Then
|
|
|
|
lblDatum.Caption = rs.getDateValue("AnlageDatum")
|
|
|
|
If Val(rs.getLongValue("PruefgangNr")) > 0 Then
|
|
lblPruefgang.Caption = rs.getLongValue("PruefgangNr")
|
|
Else
|
|
lblPruefgang.Caption = ""
|
|
End If
|
|
|
|
If Not rs.isFieldNull("PruefgangDatum") Then
|
|
lblPruefgangDatum.Caption = rs.getDateValue("PruefgangDatum")
|
|
Else
|
|
lblPruefgangDatum.Caption = ""
|
|
End If
|
|
|
|
lblWiederholung.Caption = rs.getIntValue("Wiederholung")
|
|
lblPruefstation.Caption = rs.getIntValue("Pruefstation")
|
|
lblEinbauplatz.Caption = rs.getIntValue("Einbauplatz")
|
|
lblPruefer.Caption = rs.getStringValue("Pruefer")
|
|
lblStatus.Caption = rs.getStringValue("StatusFertigung")
|
|
lblBezeichnung = rs.getStringValue("Bezeichnung")
|
|
|
|
txtAusfallgrund.text = rs.getStringValue("sonstigerAusfallgrund")
|
|
txtReparaturmassnahme.text = rs.getStringValue("Befund")
|
|
|
|
cmbBefund.text = TXT_BITTEAUSWAEHLEN
|
|
If Not rs.isFieldNull("ReparaturErfolgreich") Then
|
|
If rs.getBooleanValue("ReparaturErfolgreich") Then
|
|
cmbBefund.text = TXT_ERFOLGREICH
|
|
Else
|
|
cmbBefund.text = TXT_ERNEUTAUSGEFALLEN
|
|
End If
|
|
End If
|
|
|
|
lblFabNr.Caption = rs.getStringValue("FabNr")
|
|
|
|
Dim rsAusfallgruende As CRecordset
|
|
Set rsAusfallgruende = New CRecordset
|
|
|
|
lstAusfallgrund.Clear
|
|
Fill_lstAusfallgrund
|
|
Select_lstAusfallgrund (lngID)
|
|
|
|
txtZeitaufwand = rs.getIntValue("Zeitaufwand")
|
|
|
|
If rs.getBooleanValue("ReparaturErfolgreich") = True Then
|
|
|
|
Else
|
|
|
|
End If
|
|
|
|
|
|
strDurchfluesse = rs.getStringValue("Pruefpunkte")
|
|
strFehler = rs.getStringValue("Fehler")
|
|
|
|
msfgPruefpunkte.Cols = UBound(Split(strDurchfluesse, "|")) + 2
|
|
For i = 1 To msfgPruefpunkte.Cols - 1
|
|
msfgPruefpunkte.col = i
|
|
msfgPruefpunkte.row = 0
|
|
msfgPruefpunkte.text = Split(strDurchfluesse, "|")(i - 1)
|
|
msfgPruefpunkte.row = 1
|
|
If i <= UBound(Split(strFehler, "|")) + 1 Then
|
|
msfgPruefpunkte.text = Split(strFehler, "|")(i - 1)
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
DoEvents
|
|
cmdSave.Enabled = False
|
|
|
|
TestAufAusfallgrund
|
|
Exit Sub
|
|
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " beim Anzeigen des Rückläufers: " & Err.Description
|
|
End Sub
|
|
|
|
Private Sub TestAufAusfallgrund()
|
|
If lstAusfallgrund.SelCount = 1 And InStr(lstAusfallgrund.List(lstAusfallgrund.ListIndex), "Ausfallursache ist unklar") > 0 Then
|
|
MsgBox ("Da die Ausfallursache unklar ist, sollten Sie einen anderen Ausfallgrund angeben, sobald er bekannt ist!")
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub txtAusfallgrund_Change()
|
|
Datengeaendert
|
|
End Sub
|
|
|
|
|
|
|
|
Private Function PruefeAufPflichtfelder() As Boolean
|
|
Dim i As Integer
|
|
Dim blnAusgewaehlt As Boolean
|
|
|
|
|
|
blnAusgewaehlt = False
|
|
For i = 0 To lstAusfallgrund.ListCount - 1
|
|
If lstAusfallgrund.Selected(i) = True Then
|
|
blnAusgewaehlt = True
|
|
End If
|
|
Next
|
|
|
|
If blnAusgewaehlt = False Then
|
|
MsgBox "Bitte wählen Sie mindestens einen Ausfallgrund!", vbCritical
|
|
If lstAusfallgrund.Enabled = True Then
|
|
lstAusfallgrund.SetFocus
|
|
End If
|
|
PruefeAufPflichtfelder = False
|
|
Exit Function
|
|
End If
|
|
|
|
' If Trim(txtAusfallgrund.text) = "" Then
|
|
' MsgBox "Bitte füllen Sie das Feld 'sonstiges' aus!", vbCritical
|
|
' If txtAusfallgrund.Enabled = True Then
|
|
' txtAusfallgrund.SetFocus
|
|
' End If
|
|
' PruefeAufPflichtfelder = False
|
|
' Exit Function
|
|
' End If
|
|
' If Trim(txtReparaturmassnahme.text) = "" Then
|
|
' MsgBox "Bitte füllen Sie das Feld 'Reparaturmaßnahmen' aus!", vbCritical
|
|
' If txtReparaturmassnahme.Enabled = True Then
|
|
' txtReparaturmassnahme.SetFocus
|
|
' End If
|
|
' PruefeAufPflichtfelder = False
|
|
' Exit Function
|
|
' End If
|
|
|
|
If Trim(txtZeitaufwand.text) = "" Then
|
|
MsgBox "Bitte füllen Sie das Feld 'Zeitaufwand' aus!", vbCritical
|
|
If txtZeitaufwand.Enabled = True Then
|
|
txtZeitaufwand.SetFocus
|
|
End If
|
|
PruefeAufPflichtfelder = False
|
|
Exit Function
|
|
End If
|
|
|
|
PruefeAufPflichtfelder = True
|
|
End Function
|
|
|
|
Private Sub txtReparaturmassnahme_Change()
|
|
Datengeaendert
|
|
End Sub
|
|
|
|
Private Sub txtZeitaufwand_Change()
|
|
Datengeaendert
|
|
End Sub
|
|
|
|
|
|
Private Sub FilllstHistorie()
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim lngGesZeit As Long
|
|
|
|
Set rs = New CRecordset
|
|
strSQL = "SELECT * FROM Ruecklaeuferanalyse where SerienNr = " & m_Pruefzaehler.getSerienNr & " order by AnlageDatum"
|
|
rs.openRS strSQL, True
|
|
Set mcol_IDs = New Collection
|
|
lstHistorie.Clear
|
|
|
|
Do While Not rs.EOF
|
|
lstHistorie.AddItem Format(rs.getIntValue("ID"), "0000000") & ") " & rs.getStringValue("AnlageDatum") '& " " & rs.getStringValue("Ausfallgrund")
|
|
mcol_IDs.Add rs.getIntValue("ID"), CStr(rs.getIntValue("ID"))
|
|
lngGesZeit = lngGesZeit + rs.getIntValue("Zeitaufwand")
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
|
|
lstHistorie.AddItem NEU
|
|
|
|
lstHistorie.Selected(lstHistorie.ListCount - 1) = True
|
|
|
|
lblGesZeit.Caption = lngGesZeit
|
|
End Sub
|
|
|
|
Private Sub FelderSperren()
|
|
cmdSave.Enabled = False
|
|
End Sub
|
|
|
|
Private Sub FelderEingabenZulassen()
|
|
|
|
End Sub
|
|
|
|
Private Sub txtZeitaufwand_KeyPress(KeyAscii As Integer)
|
|
Select Case KeyAscii
|
|
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 8, 32, 13
|
|
Case Else
|
|
Debug.Print KeyAscii & " " & Chr(KeyAscii)
|
|
KeyAscii = 0
|
|
End Select
|
|
End Sub
|
|
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Private Sub cmdPrint_Click()
|
|
Dim hoehe As Long
|
|
cmdPrint.Enabled = False
|
|
Screen.MousePointer = vbHourglass
|
|
' Picture1.Visible = True
|
|
' Printer.ScaleMode = vbMillimeters
|
|
'
|
|
' Picture1.Left = 0
|
|
' Picture1.Top = 0
|
|
' Picture1.Width = Me.ScaleWidth
|
|
'
|
|
' hoehe = Me.Height
|
|
' Me.Height = Printer.ScaleHeight
|
|
' DoEvents
|
|
'
|
|
' Picture1.Height = Me.ScaleHeight
|
|
' Picture1.BackColor = vbWhite
|
|
PrintProtokoll Printer
|
|
|
|
DoEvents
|
|
cmdPrint.Enabled = True
|
|
Screen.MousePointer = vbNormal
|
|
|
|
' Picture1.Visible = False
|
|
End Sub
|
|
|
|
Private Sub PrintProtokoll(ByRef PrintObjekt As Object)
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim i As Integer
|
|
Dim lngID As Long
|
|
|
|
If PrintObjekt Is Nothing Then Set PrintObjekt = Printer
|
|
PrintObjekt.ScaleMode = vbMillimeters
|
|
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim lngGesZeit As Long
|
|
Dim lngSeite As Long
|
|
Dim lngBlockNr As Long
|
|
Const ANZAHLPROSEITE = 1
|
|
|
|
Set rs = New CRecordset
|
|
strSQL = "SELECT * FROM VIEW_Ruecklaeuferanalyse where SerienNr = " & m_Pruefzaehler.getSerienNr & " order by AnlageDatum"
|
|
|
|
|
|
rs.openRS strSQL, True
|
|
|
|
If Not rs.EOF Then
|
|
lngSeite = 1
|
|
lngBlockNr = 1
|
|
|
|
Call PrintRahmen(PrintObjekt, lngSeite, rs.RecordCount)
|
|
Call PrintKopfdaten(PrintObjekt)
|
|
lngGesZeit = 0
|
|
Do While Not rs.EOF
|
|
PrintAusfallBlock rs, PrintObjekt
|
|
lngGesZeit = lngGesZeit + rs.getLongValue("Zeitaufwand")
|
|
|
|
rs.MoveNext
|
|
lngBlockNr = lngBlockNr + 1
|
|
If lngBlockNr Mod ANZAHLPROSEITE = 0 Then
|
|
lngSeite = lngSeite + 1
|
|
' neue Seite
|
|
If Not rs.EOF Then
|
|
' es gibt noch weitere Blöcke für weitere Seiten
|
|
If TypeName(PrintObjekt) = "Printer" Then
|
|
Printer.NewPage
|
|
Else
|
|
PrintObjekt.Cls
|
|
End If
|
|
Call PrintRahmen(PrintObjekt, lngSeite, rs.RecordCount)
|
|
Call PrintKopfdaten(PrintObjekt)
|
|
End If
|
|
End If
|
|
Loop
|
|
Else
|
|
MsgBox "Es gibt keine Rückläuferdaten zu diesem Zähler"
|
|
Printer.KillDoc
|
|
Exit Sub
|
|
End If
|
|
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5
|
|
PrintObjekt.FontSize = 10
|
|
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "gesamter Zeitaufwand:", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 52, mdblCurrentY, lngGesZeit & " min", , False
|
|
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 * 2
|
|
PrintWithLinie PrintObjekt, "Befund / Reparatur-Maßnahme:"
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5 * 2
|
|
PrintWithLinie PrintObjekt, ""
|
|
|
|
mdblCurrentY = mdblUntererRand - 20
|
|
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Unterschrift:", , True
|
|
PrintObjekt.Line (mdblLinkerRand + 10 + PrintObjekt.TextWidth("Unterschrift:"), mdblCurrentY + PrintObjekt.TextHeight("X"))-(mdblLinkerRand + 10 + PrintObjekt.TextWidth("Unterschrift:") + 50, mdblCurrentY + PrintObjekt.TextHeight("X"))
|
|
|
|
PrintText PrintObjekt, mdblLinkerRand + 100, mdblCurrentY, "Datum:", , True
|
|
PrintObjekt.Line (mdblLinkerRand + 100 + PrintObjekt.TextWidth("Datum:"), mdblCurrentY + PrintObjekt.TextHeight("X"))-(mdblRechterRand - 20, mdblCurrentY + PrintObjekt.TextHeight("X"))
|
|
|
|
If TypeName(PrintObjekt) = "Printer" Then
|
|
Printer.EndDoc
|
|
End If
|
|
Exit Sub
|
|
|
|
Errorhandler:
|
|
'If TypeName(PrintObjekt) = "Printer" Then
|
|
Printer.KillDoc
|
|
MsgBox "Fehler " & Err.Number & " in PrintProtokoll() : " & Err.Description
|
|
'End If
|
|
End Sub
|
|
|
|
Private Sub PrintWithLinie(PrintObjekt As Object, strText As String, Optional MaxWidth As Variant)
|
|
|
|
If IsMissing(MaxWidth) Then
|
|
MaxWidth = mdblRechterRand - 10
|
|
Else
|
|
MaxWidth = MaxWidth + mdblLinkerRand + 10 + PrintObjekt.TextWidth(strText)
|
|
End If
|
|
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, strText, , True
|
|
PrintObjekt.Line (mdblLinkerRand + 10 + PrintObjekt.TextWidth(strText), mdblCurrentY + PrintObjekt.TextHeight(strText))-(MaxWidth, mdblCurrentY + PrintObjekt.TextHeight(strText))
|
|
End Sub
|
|
|
|
Private Sub PrintRahmen(ByRef PrintObjekt As Object, Optional lngSeitenNr As Long = 1, Optional lngAnzahlSeiten As Long = 1)
|
|
If PrintObjekt Is Nothing Then Set PrintObjekt = Printer
|
|
|
|
mdblLinkerRand = 22
|
|
mdblRechterRand = PrintObjekt.ScaleWidth - 5
|
|
mdblObererRand = 10
|
|
mdblUntererRand = PrintObjekt.ScaleHeight - 10
|
|
mdblLinie1top = mdblObererRand + 20
|
|
|
|
PrintObjekt.Line (mdblLinkerRand, mdblObererRand)-(mdblRechterRand, mdblObererRand)
|
|
PrintObjekt.Line (mdblRechterRand, mdblObererRand)-(mdblRechterRand, mdblUntererRand)
|
|
PrintObjekt.Line (mdblRechterRand, mdblUntererRand)-(mdblLinkerRand, mdblUntererRand)
|
|
PrintObjekt.Line (mdblLinkerRand, mdblUntererRand)-(mdblLinkerRand, mdblObererRand)
|
|
|
|
PrintObjekt.Line (mdblLinkerRand, mdblLinie1top)-(mdblRechterRand, mdblLinie1top)
|
|
|
|
Dim dblBildbreite As Double
|
|
Dim dblBildhoehe As Double
|
|
|
|
dblBildbreite = 45
|
|
dblBildhoehe = dblBildbreite * ImgLogo.Height / ImgLogo.Width
|
|
|
|
PrintObjekt.PaintPicture ImgLogo.Picture, mdblLinkerRand + 2, mdblObererRand + 5, dblBildbreite, dblBildhoehe
|
|
' Linie Vertikal rechts vom Bild
|
|
PrintObjekt.Line (mdblLinkerRand + dblBildbreite + 4, mdblObererRand)-(mdblLinkerRand + dblBildbreite + 4, mdblLinie1top)
|
|
' Linie horizontal halbe Höhe
|
|
PrintObjekt.Line (mdblLinkerRand + dblBildbreite + 4, mdblObererRand + 13)-(mdblRechterRand, mdblObererRand + 13)
|
|
|
|
PrintObjekt.FontSize = 12
|
|
' PrintText PrintObjekt, mdblLinkerRand + 75, mdblLinie1top - 18, "Anlage 2 zur", , False
|
|
' PrintText PrintObjekt, mdblLinkerRand + 65, mdblLinie1top - 12, "Arbeits- und Prüfanweisung", , True
|
|
'
|
|
PrintObjekt.FontSize = 12
|
|
'PrintText PrintObjekt, mdblLinkerRand + 95, mdblLinie1top - 6, "Rückläuferanalyse", , True
|
|
|
|
PrintObjekt.Font.Bold = False
|
|
PrintTextAligned PrintObjekt, "Anlage 2 zur", mdblLinkerRand + dblBildbreite + 4, mdblLinkerRand + dblBildbreite + 100, mdblLinie1top - 18, vbCenter
|
|
PrintObjekt.Font.Bold = True
|
|
PrintTextAligned PrintObjekt, "ARBEITS- UND PRÜFANWEISUNG", mdblLinkerRand + dblBildbreite + 4, mdblLinkerRand + dblBildbreite + 100, mdblLinie1top - 12, vbCenter
|
|
|
|
PrintTextAligned PrintObjekt, "Rückläuferanalyse", mdblLinkerRand + dblBildbreite + 4, mdblLinkerRand + dblBildbreite + 100, mdblLinie1top - 6, vbCenter
|
|
|
|
' vertikale Linie rechts , links neben Dokument-Nr
|
|
PrintObjekt.Line (mdblLinkerRand + dblBildbreite + 100, mdblObererRand)-(mdblLinkerRand + dblBildbreite + 100, mdblLinie1top)
|
|
|
|
PrintObjekt.FontSize = 10
|
|
PrintText PrintObjekt, mdblLinkerRand + 150, mdblObererRand + 1.5, "Dokument-Nr.:", , False
|
|
|
|
PrintObjekt.FontSize = 14
|
|
PrintText PrintObjekt, mdblLinkerRand + 150, mdblLinie1top - 13.5, "QA_M_037", , True
|
|
|
|
PrintObjekt.FontSize = 10
|
|
PrintTextAligned PrintObjekt, "Blatt: " & lngSeitenNr & " von " & lngAnzahlSeiten, mdblLinkerRand + 150, mdblRechterRand, mdblLinie1top - 6, vbCenter
|
|
|
|
mdblCurrentY = mdblLinie1top
|
|
|
|
PrintObjekt.CurrentX = mdblLinkerRand
|
|
PrintObjekt.CurrentY = mdblUntererRand + 1
|
|
PrintObjekt.Font.Size = 8
|
|
PrintObjekt.Print "gedruckt am " & Format(Now, "dd.mm.yyyy hh:mm:ss") & " von " & g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName
|
|
PrintObjekt.Font.Size = 12
|
|
End Sub
|
|
|
|
Private Sub PrintKopfdaten(ByRef PrintObjekt As Object)
|
|
If PrintObjekt Is Nothing Then Set PrintObjekt = Printer
|
|
|
|
mdblCurrentY = mdblCurrentY + 10
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Auftrag: ", False, True
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 20, mdblCurrentY, m_objAuftrag.getNr & "/" & m_objAuftragPosition.getNr
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 50, mdblCurrentY, "Kunde: ", False, True
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 75, mdblCurrentY, m_objAuftrag.getKunde.getName
|
|
|
|
mdblCurrentY = mdblCurrentY + Printer.TextHeight("X")
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 75, mdblCurrentY, m_objAuftrag.getKunde.getOrt
|
|
|
|
mdblCurrentY = mdblCurrentY + 10
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Zählertyp:", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 25, mdblCurrentY, lblBezeichnung.Caption
|
|
mdblCurrentY = mdblCurrentY + 10
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Zählernummer:", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 35, mdblCurrentY, FormatSerienNr(lblSerienNr.Caption), , True
|
|
|
|
If m_objAuftragPositionSerienNr.getKundeneigeneSerienNr <> "" Then
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 75, mdblCurrentY, "Kundeneigene SNr: ", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 10 + 120, mdblCurrentY, m_objAuftragPositionSerienNr.getKundeneigeneSerienNr, , True
|
|
End If
|
|
|
|
|
|
mdblCurrentY = mdblCurrentY + 5
|
|
|
|
End Sub
|
|
|
|
Private Sub PrintAusfallBlock(rs As CRecordset, ByRef PrintObjekt As Object)
|
|
Dim dblLinksOben As Double
|
|
Dim dblRechtsOben As Double
|
|
Dim dblOben As Double
|
|
Dim blnHasPruefgang As Boolean
|
|
|
|
If PrintObjekt Is Nothing Then Set PrintObjekt = Printer
|
|
dblLinksOben = mdblLinkerRand + 5
|
|
dblRechtsOben = mdblRechterRand - 5
|
|
mdblCurrentY = mdblCurrentY + 5
|
|
dblOben = mdblCurrentY
|
|
|
|
' obere Linie
|
|
PrintObjekt.Line (dblLinksOben, mdblCurrentY)-(dblRechtsOben, mdblCurrentY)
|
|
PrintObjekt.Font.Size = 10
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X")
|
|
PrintText PrintObjekt, mdblLinkerRand + 12, mdblCurrentY, "Prüfstation: ", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 35, mdblCurrentY, rs.getIntValue("Pruefstation")
|
|
|
|
PrintText PrintObjekt, mdblLinkerRand + 50, mdblCurrentY, "Zählerposition: ", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 80, mdblCurrentY, rs.getIntValue("Einbauplatz")
|
|
|
|
PrintText PrintObjekt, mdblLinkerRand + 90, mdblCurrentY, "Prüfer: ", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 107, mdblCurrentY, rs.getStringValue("Pruefer") & " (" & rs.getStringValue("PrueferNr") & ")"
|
|
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5
|
|
|
|
If rs.getLongValue("PruefgangNr") <> 0 Then
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Prüfgang: ", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 30, mdblCurrentY, rs.getLongValue("PruefgangNr")
|
|
blnHasPruefgang = True
|
|
End If
|
|
|
|
Dim strPruefpunkte As String
|
|
strPruefpunkte = Trim(rs.getStringValue("Pruefpunkte"))
|
|
If strPruefpunkte <> "" Then
|
|
blnHasPruefgang = True
|
|
Dim varTmp As Variant
|
|
Dim i As Integer
|
|
i = 1
|
|
PrintText PrintObjekt, mdblLinkerRand + 80, mdblCurrentY, "Q [m³/h]"
|
|
PrintObjekt.Line (mdblLinkerRand + 80, mdblCurrentY + 5)-(mdblLinkerRand + 80 + 15, mdblCurrentY + 5)
|
|
PrintText PrintObjekt, mdblLinkerRand + 68, mdblCurrentY + 6, "Abweichung [%]"
|
|
|
|
For Each varTmp In Split(strPruefpunkte, "|")
|
|
PrintObjekt.Line (mdblLinkerRand + 80 + i * 15, mdblCurrentY + 5)-(mdblLinkerRand + 80 + (i + 1) * 15, mdblCurrentY + 5)
|
|
PrintObjekt.Line (mdblLinkerRand + 80 + i * 15, mdblCurrentY)-(mdblLinkerRand + 80 + i * 15, mdblCurrentY + 10)
|
|
PrintText PrintObjekt, mdblLinkerRand + 70 + (i + 1) * 15, mdblCurrentY, varTmp
|
|
|
|
Dim strFehler As String
|
|
|
|
If i <= UBound(Split(rs.getStringValue("Fehler"), "|")) + 1 Then
|
|
strFehler = Split(rs.getStringValue("Fehler"), "|")(i - 1)
|
|
PrintText PrintObjekt, mdblLinkerRand + 70 + (i + 1) * 15, mdblCurrentY + 6, strFehler
|
|
End If
|
|
i = i + 1
|
|
Next
|
|
End If
|
|
If blnHasPruefgang Then
|
|
mdblCurrentY = mdblCurrentY + 15
|
|
End If
|
|
|
|
If rs.getLongValue("FabNr") Then
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Geräte-Nr.:", True
|
|
PrintText PrintObjekt, mdblLinkerRand + 30, mdblCurrentY, rs.getLongValue("FabNr")
|
|
mdblCurrentY = mdblCurrentY + Printer.TextHeight("X") * 1.5
|
|
End If
|
|
|
|
|
|
|
|
''''''''''''''''''''''''''''
|
|
Dim rsAusfall As CRecordset
|
|
Set rsAusfall = New CRecordset
|
|
|
|
Dim strSQL As String
|
|
strSQL = "SELECT * FROM Ruecklaeufer_Ausfallgrund "
|
|
strSQL = strSQL & "INNER JOIN Ausfallgruende ON Ruecklaeufer_Ausfallgrund.Ausfallgrund_ID = Ausfallgruende.ID "
|
|
strSQL = strSQL & "WHERE (Ruecklaeufer_Ausfallgrund.Ruecklaufer_ID = " & rs.getIntValue("ID") & ") ORDER BY Ausfallgruende.Sortorder"
|
|
rsAusfall.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Ausfallgründe: ", , True
|
|
|
|
Do While Not rsAusfall.EOF
|
|
PrintText PrintObjekt, mdblLinkerRand + 40, mdblCurrentY, rsAusfall.getStringValue("Text")
|
|
mdblCurrentY = mdblCurrentY + Printer.TextHeight("X")
|
|
rsAusfall.MoveNext
|
|
Loop
|
|
End If
|
|
|
|
Dim ymax As Double
|
|
Dim strTemp As String
|
|
Dim varZeile As Variant
|
|
|
|
strTemp = rs.getStringValue("sonstigerAusfallgrund")
|
|
If Trim(strTemp) <> "" Then
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5
|
|
For Each varZeile In Split(strTemp, vbCrLf)
|
|
ymax = mdblCurrentY + 40
|
|
WrapText PrintObjekt, Trim(varZeile), mdblLinkerRand + 20, mdblRechterRand - 10, mdblCurrentY, ymax, False
|
|
mdblCurrentY = PrintObjekt.CurrentY
|
|
Next
|
|
End If
|
|
|
|
mdblCurrentY = mdblCurrentY + 5
|
|
|
|
strTemp = rs.getStringValue("Befund")
|
|
If Trim(strTemp) <> "" Then
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Befund: ", , True
|
|
PrintObjekt.Font.Bold = False
|
|
mdblCurrentY = mdblCurrentY + PrintObjekt.TextHeight("X") * 1.5
|
|
For Each varZeile In Split(strTemp, vbCrLf)
|
|
ymax = mdblCurrentY + 40
|
|
WrapText PrintObjekt, Trim(varZeile), mdblLinkerRand + 20, mdblRechterRand - 10, mdblCurrentY, ymax, False
|
|
mdblCurrentY = PrintObjekt.CurrentY
|
|
Next
|
|
End If
|
|
|
|
mdblCurrentY = mdblCurrentY + 5
|
|
PrintText PrintObjekt, mdblLinkerRand + 10, mdblCurrentY, "Zeitaufwand:", , True
|
|
PrintText PrintObjekt, mdblLinkerRand + 45, mdblCurrentY, rs.getLongValue("Zeitaufwand") & " min", , False
|
|
mdblCurrentY = mdblCurrentY + 5
|
|
|
|
PrintObjekt.Line (dblLinksOben, mdblCurrentY)-(dblRechtsOben, mdblCurrentY)
|
|
PrintObjekt.Line (dblLinksOben, dblOben)-(dblLinksOben, mdblCurrentY)
|
|
PrintObjekt.Line (dblRechtsOben, dblOben)-(dblRechtsOben, mdblCurrentY)
|
|
|
|
mdblCurrentY = mdblCurrentY + 5
|
|
End Sub
|
|
|
|
Private Sub SaveAusfallgruende(RuecklaeuferID As Long)
|
|
Dim rs As CRecordset
|
|
Dim blnIstSelected As Boolean
|
|
Dim i As Integer
|
|
|
|
Dim lngAusfallgrundID As Long
|
|
|
|
For i = 0 To lstAusfallgrund.ListCount - 1
|
|
lngAusfallgrundID = Val(lstAusfallgrund.List(i))
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS "SELECT * FROM Ruecklaeufer_Ausfallgrund where Ruecklaufer_ID=" & RuecklaeuferID & " and Ausfallgrund_ID=" & lngAusfallgrundID
|
|
If rs.EOF Then
|
|
' kein Datensatz vorhanden
|
|
If lstAusfallgrund.Selected(i) = True Then
|
|
' ist ausgewählt ? Dann als neu hinzufügen
|
|
rs.addNew
|
|
rs.setValue "Ruecklaufer_ID", RuecklaeuferID
|
|
rs.setValue "Ausfallgrund_ID", lngAusfallgrundID
|
|
Debug.Print RuecklaeuferID & "/" & lngAusfallgrundID & " neu"
|
|
rs.update
|
|
Else
|
|
'Debug.Print RuecklaeuferID & "/" & lngAusfallgrundID & " bleibt draußen"
|
|
End If
|
|
Else
|
|
' Datensatz vorhanden
|
|
If lstAusfallgrund.Selected(i) = True Then
|
|
|
|
Else
|
|
Debug.Print RuecklaeuferID & "/" & lngAusfallgrundID & " wird gelöscht"
|
|
rs.delete
|
|
rs.update
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
End Sub
|
|
|