Exported VBA
This commit is contained in:
613
wgmaster/vba/MChargen.bas
Normal file
613
wgmaster/vba/MChargen.bas
Normal file
@ -0,0 +1,613 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Function GetActiveCharge(SNR1 As String, QSNR1 As Long, ZNR1 As Long, Optional ByVal SANR1 As Variant) As Long
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Suche nach Charge, die alle Kriterien erfüllt
|
||||
If Not IsNull(SANR1) And SANR1 <> "" Then
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TChargen WHERE SNR='" + SNR1 + "' AND SANR='" + SANR1 + "' AND (QSNRVon<=" + Format(QSNR1) + " OR ISNULL(QSNRVon)) AND (QSNRBis>=" + Format(QSNR1) + " OR IsNull(QSNRBis)) AND ZNR=" + Format(ZNR1) + " AND CSNR=2")
|
||||
Else
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TChargen WHERE SNR='" + SNR1 + "' AND (QSNRVon<=" + Format(QSNR1) + " OR ISNULL(QSNRVon)) AND (QSNRBis>=" + Format(QSNR1) + " OR IsNull(QSNRBis)) AND ZNR=" + Format(ZNR1) + " AND CSNR=2")
|
||||
End If
|
||||
If rs1.EOF Then
|
||||
GetActiveCharge = -1
|
||||
Else
|
||||
GetActiveCharge = rs1("CNR")
|
||||
End If
|
||||
rs1.Close
|
||||
|
||||
End Function
|
||||
|
||||
Public Function ChargeBefuellen(CNR1 As Long, LINR1 As Long) As Boolean
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsb As Recordset
|
||||
Dim verbuchen As Boolean
|
||||
|
||||
ChargeBefuellen = False
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
If rsc.EOF Then
|
||||
rsc.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsc("BNR")))
|
||||
If rsb.EOF Then
|
||||
rsb.Close
|
||||
MsgBox ("Behälter nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'2. Überprüfen, ob Charge im richtigen Status und Lieferung zugeordnet
|
||||
'TODO
|
||||
'Charge im Status 2?
|
||||
'Lieferung ist diese Charge zugeordnet?
|
||||
'Chargentyp=Maische?
|
||||
|
||||
|
||||
If rsl("AufChargeVerbucht") = True Then
|
||||
If MsgBox("Diese Lieferung wurde bereits verbucht! Sind Sie sicher, diese Lieferung nochmals zu verbuchen?", vbYesNo) = vbYes Then
|
||||
verbuchen = True
|
||||
Else
|
||||
verbuchen = False
|
||||
End If
|
||||
Else
|
||||
verbuchen = True
|
||||
End If
|
||||
|
||||
|
||||
'3. Aktualisierung Menge und Oechsle unter Berücksichtigung des Reduktionsfaktors
|
||||
If verbuchen = True Then
|
||||
|
||||
rsc.Edit
|
||||
If IsNull(rsc("Oechsle")) Or IsNull(rsc("Menge")) Then
|
||||
'erste lieferung
|
||||
rsc("Oechsle") = rsl("Oechsle")
|
||||
rsc("Menge") = rsl("Gewicht")
|
||||
Else
|
||||
rsc("Oechsle") = (rsc("Menge") * rsc("Oechsle") + rsl("Gewicht") * rsl("Oechsle")) / (rsc("Menge") + rsl("Gewicht"))
|
||||
rsc("Menge") = rsc("Menge") + rsl("Gewicht")
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'4. Überprüfung der Charge, ob voll wird
|
||||
'If rsc("Menge") > rsb("MaxMenge") And GetParameter("CHARGENWARNUNG_BEHAELTERVOLL") = "Ja" Then
|
||||
' If MsgBox("Der Behälter der ausgewählten Charge wird mit dieser Lieferung überfüllt! Wollen Sie die Befüllung trotzdem durchführen?", vbYesNo) = vbYes Then
|
||||
' rsc.update
|
||||
' Else
|
||||
' End If
|
||||
'Else
|
||||
rsc.Update
|
||||
|
||||
'5. Aktualisieren der Lieferung
|
||||
'rsl.Edit
|
||||
'rsl("AufChargeVerbucht") = True
|
||||
'rsl.Update
|
||||
ChargeBefuellen = True
|
||||
End If
|
||||
|
||||
|
||||
rsc.Close
|
||||
rsb.Close
|
||||
rsl.Close
|
||||
|
||||
End Function
|
||||
|
||||
Public Sub ChargeBefuellungRueckgaengig(CNR1 As Long, LINR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsb As Recordset
|
||||
Dim verbuchen As Boolean
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
If rsc.EOF Then
|
||||
rsc.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If rsl("AufChargeVerbucht") = False Then
|
||||
If MsgBox("Diese Lieferung wurde noch gar nicht verbucht! Sind Sie sicher, die Verbuchung rückgängig zu machen?", vbYesNo) = vbYes Then
|
||||
verbuchen = True
|
||||
Else
|
||||
verbuchen = False
|
||||
End If
|
||||
Else
|
||||
verbuchen = True
|
||||
End If
|
||||
|
||||
If verbuchen = True Then
|
||||
'2. Aktualisierung Menge und Oechsle unter Berücksichtigung des Reduktionsfaktors
|
||||
rsc.Edit
|
||||
If rsc("Oechsle") > 0 And rsc("Menge") > rsl("Gewicht") Then
|
||||
rsc("Oechsle") = (rsc("Oechsle") * rsc("Menge") - rsl("Gewicht") * rsl("Oechsle")) / (rsc("Menge") - rsl("Gewicht"))
|
||||
rsc("Menge") = rsc("Menge") - rsl("Gewicht")
|
||||
End If
|
||||
rsc.Update
|
||||
|
||||
'3. Verbuchung Kennzeichnung aufheben
|
||||
rsl.Edit
|
||||
rsl("AufChargeVerbucht") = False
|
||||
rsl.Update
|
||||
End If
|
||||
|
||||
|
||||
rsc.Close
|
||||
rsl.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function NeueCharge(Optional Lesejahr As Long) As Long
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim CNR1 As Long
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen")
|
||||
|
||||
'If rsc.recordcount = 0 Then
|
||||
' CNR1 = 1
|
||||
'Else
|
||||
' CNR1 = DMax("CNR", "TChargen") + 1
|
||||
'End If
|
||||
|
||||
rsc.AddNew
|
||||
'rsc("CNR") = CNR1
|
||||
NeueCharge = rsc("CNR")
|
||||
rsc("Menge") = 0
|
||||
rsc("ZNR") = GetParameter("LETZTEZNR")
|
||||
If Lesejahr > 0 Then
|
||||
rsc("Jahrgang") = Lesejahr
|
||||
End If
|
||||
rsc("CSNR") = 1
|
||||
rsc("Art") = "Maische"
|
||||
rsc.Update
|
||||
rsc.Close
|
||||
|
||||
End Function
|
||||
|
||||
Function ChargeClonen(CNR1 As Long, BNR1 As Long, Optional Menge1 As Long, Optional Oechsle1 As Long) As Long
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsc2 As Recordset
|
||||
Dim i
|
||||
Dim Maxcounter1 As Long
|
||||
Set db1 = CurrentDb
|
||||
Dim CNR2 As Long
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen where CNR=" + Format(CNR1))
|
||||
Set rsc2 = db1.OpenRecordset("SELECT * FROM TChargen")
|
||||
|
||||
If Not rsc.EOF Then
|
||||
rsc2.AddNew
|
||||
For i = 0 To rsc2.Fields.Count - 1
|
||||
If rsc2.Fields(i).Name <> "Chargennummer" And rsc2.Fields(i).Name <> "CNR" And rsc2.Fields(i).Name <> "BNR" Then
|
||||
rsc2.Fields(i) = rsc.Fields(i)
|
||||
End If
|
||||
Next i
|
||||
'CNR2 = DMax("CNR", "TChargen") + 1
|
||||
'rsc2("CNR") = CNR2
|
||||
ChargeClonen = rsc2("CNR")
|
||||
CNR2 = rsc2("CNR")
|
||||
rsc2("BNR") = BNR1
|
||||
If Not IsNull(Menge1) Then
|
||||
rsc2("Menge") = Menge1
|
||||
End If
|
||||
If Not IsNull(Oechsle1) Then
|
||||
rsc2("Oechsle") = Oechsle1
|
||||
End If
|
||||
rsc2("CSNR") = 2
|
||||
rsc2.Update
|
||||
rsc2.Close
|
||||
Set rsc2 = db1.OpenRecordset("SELECT * FROM TChargen where CNR=" + Format(CNR2))
|
||||
rsc2.Edit
|
||||
rsc2("Chargennummer") = GeneriereChargennummer(rsc2("CNR"), Maxcounter1)
|
||||
rsc2("ChargennummerZaehler") = Maxcounter1
|
||||
rsc2.Update
|
||||
End If
|
||||
rsc.Close
|
||||
rsc2.Close
|
||||
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function GeneriereChargennummer(CNR1 As Long, Optional Maxcounter1 As Long) As String
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim Chargennummer As String
|
||||
Dim Maxcounter As Long
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
|
||||
Select Case GetParameter("CHARGENNUMMERTYP")
|
||||
|
||||
Case "1": 'BehälterKurzbezeichnung + Zähler (pro Behälter)+ DatumBefüllung
|
||||
|
||||
If rsc("BNR") > 0 And rsc("Jahrgang") > 0 Then
|
||||
If IsNull(DMax("ChargennummerZaehler", "TChargen", "BNR=" + Format(rsc("BNR")) + " AND Jahrgang=" + Format(rsc("Jahrgang")))) Then
|
||||
Maxcounter = 0
|
||||
Else
|
||||
Maxcounter = DMax("ChargennummerZaehler", "TChargen", "BNR=" + Format(rsc("BNR")) + " AND Jahrgang=" + Format(rsc("Jahrgang")))
|
||||
End If
|
||||
Chargennummer = DFirst("Kurzbezeichnung", "TBehaelter", "BNR=" + Format(rsc("BNR"))) + "-" + Format(Maxcounter + 1, "0000") + "-" + Format(year(Date), "0000") + Format(Month(Date), "00") + Format(Day(Date), "00")
|
||||
Maxcounter1 = Maxcounter + 1
|
||||
End If
|
||||
|
||||
Case "2":
|
||||
|
||||
|
||||
Case "3":
|
||||
|
||||
|
||||
End Select
|
||||
|
||||
rsc.Close
|
||||
GeneriereChargennummer = Chargennummer
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub ChargeBefuellungStarten(CNR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
|
||||
If Not rsc.EOF Then
|
||||
|
||||
'div. Abfragen
|
||||
If rsc("CSNR") <> 1 Then
|
||||
MsgBox "Die Befüllung kann nur aus dem Zustand 'Erstellt' aus starten!", vbCritical
|
||||
rsc.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If IsNull(rsc("BNR")) Then
|
||||
MsgBox "Bitte zuerst einen Behälter zuweisen!", vbCritical
|
||||
rsc.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
rsc.Edit
|
||||
rsc("CSNR") = 2
|
||||
rsc("Befuellungsbeginn") = Date
|
||||
rsc.Update
|
||||
|
||||
End If
|
||||
rsc.Close
|
||||
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ChargeBefuellungBeenden(CNR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
|
||||
If Not rsc.EOF Then
|
||||
|
||||
'div. Abfragen
|
||||
If rsc("CSNR") <> 2 Then
|
||||
MsgBox "Die Befüllung kann nur aus dem Zustand 'Befüllung' aus beendet werden!", vbCritical
|
||||
rsc.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
rsc.Edit
|
||||
rsc("CSNR") = 3
|
||||
rsc("Befuellungsende") = Date
|
||||
rsc.Update
|
||||
|
||||
End If
|
||||
rsc.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChargenErstellenAusPlanung(date1 As Date)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsp As Recordset
|
||||
Dim rsc As Recordset
|
||||
Dim CNR1 As Long
|
||||
Dim CSNR1 As Long
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rsp = db1.OpenRecordset("SELECT * FROM TLeseplanung WHERE Datum=DateValue('" + Format(date1) + "') ORDER BY SNR")
|
||||
If rsp.EOF Then
|
||||
MsgBox "Keine Planung für diesen Tag gefunden!", vbCritical
|
||||
rsp.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If MsgBox("Wollen Sie die Chargen gleich zur Befüllung freigeben?", vbYesNo) = vbYes Then
|
||||
CSNR1 = 2
|
||||
Else
|
||||
CSNR1 = 1
|
||||
End If
|
||||
|
||||
While Not rsp.EOF
|
||||
|
||||
CNR1 = NeueCharge(year(rsp("Datum")))
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
rsc.Edit
|
||||
rsc("SNR") = rsp("SNR")
|
||||
If Not IsNull(rsp("SANR")) Then
|
||||
rsc("SANR") = rsp("SANR")
|
||||
End If
|
||||
rsc("Befuellungsbeginn") = rsp("Datum")
|
||||
rsc("Jahrgang") = year(rsp("Datum"))
|
||||
If Not IsNull(rsp("QSNRVon")) Then
|
||||
rsc("QSNRVon") = rsp("QSNRVon")
|
||||
End If
|
||||
If Not IsNull(rsp("QSNRBis")) Then
|
||||
rsc("QSNRBis") = rsp("QSNRBis")
|
||||
End If
|
||||
rsc("CSNR") = CSNR1
|
||||
|
||||
rsc.Update
|
||||
rsc.Close
|
||||
rsp.MoveNext
|
||||
Wend
|
||||
rsp.Close
|
||||
MsgBox ("Bitte den Chargen noch Behälter zuordnen")
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChargeUmfuellen(CNRVon As Long, CNRNach As Long, Menge As Double, Optional MengeZuruecksetzen As Boolean, Optional OechsleZuruecksetzen As Boolean, Optional StatusEntleert As Boolean)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsvon As Recordset
|
||||
Dim rsnach As Recordset
|
||||
Dim rsh As Recordset
|
||||
Dim rsb As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rsvon = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRVon))
|
||||
Set rsnach = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRNach))
|
||||
Set rsh = db1.OpenRecordset("SELECT * FROM TChargenHierarchie WHERE CNR_Parent=" + Format(CNRVon) + " AND CNR_Child=" + Format(CNRNach))
|
||||
Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsnach("BNR")))
|
||||
|
||||
'Anwendung des Reduktionsfaktors
|
||||
Menge = Menge * rsb("Reduktionsfaktor")
|
||||
|
||||
'Überprüfe Überschreitung des Füllstandes der Zielcharge
|
||||
If rsb("MaxMenge") < rsnach("Menge") + Menge Then
|
||||
If MsgBox("Die angegebene Menge würde die maximal mögliche Füllmenge des Behälters überschreiten. Maximal sind " + Format(rsb("MaxMenge") - rsnach("Menge")) + " möglich. Wollen Sie trotzdem die Umfüllung vornehmen?", vbYesNo) = vbNo Then
|
||||
rsvon.Close
|
||||
rsnach.Close
|
||||
rsh.Close
|
||||
rsb.Close
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
'Update Hierarchie
|
||||
If rsh.EOF Then
|
||||
rsh.AddNew
|
||||
rsh("CNR_Parent") = CNRVon
|
||||
rsh("CNR_Child") = CNRNach
|
||||
Else
|
||||
rsh.Edit
|
||||
End If
|
||||
|
||||
If IsNull(rsh("Menge")) Then
|
||||
rsh("Menge") = Menge
|
||||
Else
|
||||
rsh("Menge") = rsh("Menge") + Menge
|
||||
End If
|
||||
rsh.Update
|
||||
|
||||
'Update Zielcharge
|
||||
rsnach.Edit
|
||||
If IsNull(rsnach("Menge")) Then
|
||||
rsnach("Menge") = 0
|
||||
End If
|
||||
If IsNull(rsnach("Oechsle")) Then
|
||||
rsnach("Oechsle") = 0
|
||||
End If
|
||||
|
||||
|
||||
|
||||
rsnach("Oechsle") = (rsnach("Menge") * rsnach("Oechsle") + Menge * rsvon("Oechsle") * rsb("Reduktionsfaktor")) / (rsnach("Menge") + Menge * rsb("Reduktionsfaktor"))
|
||||
rsnach("Menge") = rsnach("Menge") + Menge * rsb("Reduktionsfaktor")
|
||||
rsnach.Update
|
||||
|
||||
'Update Ursprungscharge
|
||||
rsvon.Edit
|
||||
If StatusEntleert And rsvon("Menge") <= 0 Then
|
||||
rsvon("CSNR") = 4
|
||||
End If
|
||||
If MengeZuruecksetzen Then
|
||||
rsvon("Menge") = rsvon("Menge") - Menge
|
||||
End If
|
||||
If OechsleZuruecksetzen Then
|
||||
rsvon("Oechsle") = Null
|
||||
End If
|
||||
rsvon.Update
|
||||
|
||||
rsvon.Close
|
||||
rsnach.Close
|
||||
rsh.Close
|
||||
rsb.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Function ChargeStandNachFuellung(LINR1 As Long) As Double
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsb As Recordset
|
||||
Dim ueberfuellt As Double
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
'MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(rsl("CNR")))
|
||||
If rsc.EOF Then
|
||||
rsc.Close
|
||||
'MsgBox ("Charge nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsc("BNR")))
|
||||
If rsb.EOF Then
|
||||
rsb.Close
|
||||
'MsgBox ("Behälter nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'2. Überprüfen, ob Charge im richtigen Status und Lieferung zugeordnet
|
||||
'TODO
|
||||
'Charge im Status 2?
|
||||
'Lieferung ist diese Charge zugeordnet?
|
||||
'Chargentyp=Maische?
|
||||
|
||||
If IsNull(rsc("Menge")) Then
|
||||
ueberfuellt = rsl("Gewicht") - rsb("MaxMenge")
|
||||
Else
|
||||
ueberfuellt = rsc("Menge") + rsl("Gewicht") - rsb("MaxMenge")
|
||||
End If
|
||||
ChargeStandNachFuellung = ueberfuellt
|
||||
|
||||
rsc.Close
|
||||
rsb.Close
|
||||
rsl.Close
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub ChargenZuLieferungenZuordnen(Lesejahr1 As Long, Optional ZNR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim where1 As String
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
If ZNR1 > 0 Then
|
||||
where1 = " WHERE Year(Datum)=" + Format(Lesejahr1) + " AND ZNR=" + Format(ZNR1)
|
||||
Else
|
||||
where1 = " WHERE Year(Datum)=" + Format(Lesejahr1)
|
||||
End If
|
||||
where1 = where1 + " AND NOT SNR=Null and not QSNR=Null and not Datum=Null "
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen " + where1)
|
||||
While Not rsl.EOF
|
||||
where1 = " WHERE SNR='" + Format(rsl("SNR")) + "' AND Befuellungsbeginn=DateValue('" + Format(rsl("Datum"), "dd.mm.yyyy") + "') "
|
||||
where1 = where1 + " AND (QSNRVon<=" + Format(rsl("QSNR")) + " OR QSNRVon=Null) AND (QSNRBis>=" + Format(rsl("QSNR")) + " OR QSNRBis=Null)"
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen " + where1)
|
||||
If IsNull(rsl("CNR")) Then
|
||||
If Not rsc.EOF Then
|
||||
rsl.Edit
|
||||
rsl("CNR") = rsc("CNR")
|
||||
rsl("AufChargeVerbucht") = True
|
||||
rsl.Update
|
||||
End If
|
||||
End If
|
||||
rsl.MoveNext
|
||||
Wend
|
||||
|
||||
db1.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChargenLieferungenZuordnungÄndern(LINR1 As Long, CNRVon As Long, CNRNach As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc_von As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsc_nach As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsc_von = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRVon))
|
||||
If rsc_von.EOF Then
|
||||
rsc_von.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set rsc_nach = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRNach))
|
||||
If rsc_nach.EOF Then
|
||||
rsc_nach.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
ChargeBefuellungRueckgaengig CNRVon, LINR1
|
||||
ChargeBefuellen CNRNach, LINR1
|
||||
|
||||
|
||||
End Sub
|
||||
Reference in New Issue
Block a user