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