Private Sub Babbrechen_Click()

DoCmd.Close

End Sub

Private Sub BOk_Click()

Dim filter1

'filter1 = GetFilter
filter1 = ""

Select Case OSortierung

Case 1: 'Null-Lieferungen

DoCmd.OpenReport "BNulllieferungen", acViewPreview, , filter1
        
Case 2: 'Über/Unterlieferungen

DoCmd.OpenReport "BÜberlieferungen", acViewPreview, , filter1

Case 3: 'Unterlieferungen lt. Flächenbindungen

CreateTempTable
DoCmd.OpenReport "BUnterlieferungenFlächenbindung", acViewPreview

End Select


End Sub

Function GetFilter() As String

Dim filter1 As String

'If IsNull(TZNR) Then
' filter1 = "TLieferungen.ZNR>=0"
'Else
' filter1 = "TLieferungen.ZNR=" + Format(TZNR)
'End If

If Not IsNull(TLesejahr) Then
 filter1 = " Year(Datum)=" + Format(TLesejahr)
End If

GetFilter = filter1

End Function

Private Sub Form_Open(Cancel As Integer)

OSortierung = 1
TErtragsgrenze = 7500
TErtragsgrenze.Visible = False
OAlleAnzeigen.Visible = False

OLiefermengen = False

If Month(Date) < 9 Then
 TLesejahr = year(Date) - 1
Else
 TLesejahr = year(Date)
End If

End Sub


Private Sub OLiefermengen_Click()

If OLiefermengen = True Then
 TErtragsgrenze.Visible = False
Else
 TErtragsgrenze.Visible = True
End If

End Sub

Private Sub OSortierung_Click()

If OSortierung = 3 Then
  OLiefermengen.Visible = True
    If OLiefermengen = True Then
     TErtragsgrenze.Visible = False
    Else
     TErtragsgrenze.Visible = True
    End If
 OAlleAnzeigen.Visible = True
 OAlleAnzeigen = False
Else
  OLiefermengen.Visible = False
 TErtragsgrenze.Visible = False
 OAlleAnzeigen.Visible = False
End If

End Sub

Sub CreateTempTable()


Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim temptablename As String
Dim query1 As String
Dim Lesejahr1
Dim ERWARTETERERTRAG

Lesejahr1 = Forms!MUnterlieferungen!TLesejahr

temptablename = "xTempFlabiLief"
Set db1 = CurrentDb


'On Error Resume Next
db1.Execute ("DELETE * FROM " + temptablename)
'db1.Execute ("CREATE TABLE " + temptablename + "(MGNR LONG,SNR STRING, SANR STRING, SUMMEFLAECHE DOUBLE,SUMMEGEWICHT DOUBLE,ERTRAG DOUBLE,ERWARTETERERTRAG DOUBLE)")


Set rs1 = db1.OpenRecordset(temptablename)
Set rs2 = db1.OpenRecordset("SELECT MGNR,SNR,SANR, Sum(Flaeche) AS SUMFL FROM TFlaechenbindungen WHERE Von<=" + Format(Lesejahr1) + " AND (Bis=Null OR Bis>=" + Format(Lesejahr1) + ") AND NOT ISNULL(SNR) AND NOT ISNULL(MGNR) GROUP BY SNR,SANR, MGNR")

While Not rs2.EOF
 rs1.AddNew
 rs1!MGNR = rs2!MGNR
 rs1!SNR = rs2!SNR
 If Not IsNull(rs2("SANR")) Then
  rs1!SANR = rs2!SANR
 End If
 rs1!SUMMEFLAECHE = rs2!SUMFL
 rs1!SummeGewicht = 0
 rs1!Ertrag = 0
 rs1.Update
 
 rs2.MoveNext
Wend
rs2.Close
rs1.Close


Set db1 = CurrentDb
'MsgBox (query1)

Set rs1 = db1.OpenRecordset("SELECT * FROM " + temptablename + " ORDER BY MGNR,SNR,SANR")

While Not rs1.EOF

  rs1.Edit
  If OLiefermengen Then
   If IsNull(rs1("SANR")) Then
    ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR IS NULL")
   Else
    ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'")
   End If
  Else
   ERWARTETERERTRAG = TErtragsgrenze
  End If
  If IsNull(ERWARTETERERTRAG) Then
   ERWARTETERERTRAG = 7500
  End If
  rs1!ERWARTETERERTRAG = ERWARTETERERTRAG

 If IsNull(rs1("SANR")) Then
  query1 = "SELECT Sum(Gewicht) AS SUMKG FROM TLieferungen WHERE Year([Datum]) = " + Format(Lesejahr1) + " And TLieferungen.Storniert <> True AND MGNR=" + Format(rs1("MGNR")) + " AND SNR='" + rs1("SNR") + "' AND SANR IS NULL"
 Else
  query1 = "SELECT Sum(Gewicht) AS SUMKG FROM TLieferungen WHERE Year([Datum]) = " + Format(Lesejahr1) + " And TLieferungen.Storniert <> True AND MGNR=" + Format(rs1("MGNR")) + " AND SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'"
 End If
 Set rs2 = db1.OpenRecordset(query1)
 
 If rs2.EOF Then
  'keine Lieferungen gefunden
  rs1!SummeGewicht = 0
  rs1!Ertrag = 0
 Else
  'lieferung gefunden
  rs1!SummeGewicht = rs2!SUMKG
  rs1!Ertrag = rs2!SUMKG * 10000 / rs1!SUMMEFLAECHE
 End If
 rs1.Update
 rs2.Close
  
 rs1.MoveNext
Wend
rs1.Close

End Sub

Sub CreateTempTable_old()


Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim temptablename As String
Dim query1 As String
Dim Lesejahr1
Dim ERWARTETERERTRAG

Lesejahr1 = Forms!MUnterlieferungen!TLesejahr

temptablename = "xTempFlabiLief"
Set db1 = CurrentDb


'On Error Resume Next
db1.Execute ("DELETE * FROM " + temptablename)
'db1.Execute ("CREATE TABLE " + temptablename + "(MGNR LONG,SNR STRING, SANR STRING, SUMMEFLAECHE DOUBLE,SUMMEGEWICHT DOUBLE,ERTRAG DOUBLE,ERWARTETERERTRAG DOUBLE)")


Set rs1 = db1.OpenRecordset(temptablename)
Set rs2 = db1.OpenRecordset("SELECT MGNR,SNR,SANR, Sum(Flaeche) AS SUMFL FROM TFlaechenbindungen WHERE Von<=" + Format(Lesejahr1) + " AND (Bis=Null OR Bis>=" + Format(Lesejahr1) + ") AND NOT ISNULL(SNR) AND NOT ISNULL(MGNR) GROUP BY SNR,SANR, MGNR")

While Not rs2.EOF
 rs1.AddNew
 rs1!MGNR = rs2!MGNR
 rs1!SNR = rs2!SNR
 If Not IsNull(rs2("SANR")) Then
  rs1!SANR = rs2!SANR
 End If
 rs1!SUMMEFLAECHE = rs2!SUMFL
 rs1!SummeGewicht = 0
 rs1!Ertrag = 0
 rs1.Update
 
 rs2.MoveNext
Wend
rs2.Close
rs1.Close

query1 = "SELECT MGNR, UCase(SNR) AS SNR1, SANR, Sum(Gewicht) AS SUMKG FROM TLieferungen WHERE Year([Datum]) = " + Format(Lesejahr1) + " And TLieferungen.Storniert <> True GROUP BY MGNR, SNR,SANR ORDER BY MGNR,SNR, SANR"

Set db1 = CurrentDb
'MsgBox (query1)

Set rs2 = db1.OpenRecordset(query1)
Set rs1 = db1.OpenRecordset("SELECT * FROM " + temptablename + " ORDER BY MGNR,SNR,SANR")

While Not rs2.EOF And Not rs1.EOF

  
 If rs1!MGNR = rs2!MGNR And rs1!SNR = rs2!SNR1 And (IsNull(rs1!SANR) Or rs1!SANR = rs2!SANR) Then
  rs1.Edit
  rs1!SummeGewicht = rs2!SUMKG
  rs1!Ertrag = rs2!SUMKG * 10000 / rs1!SUMMEFLAECHE
  If OLiefermengen Then
   If IsNull(rs1("SANR")) Then
    ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR IS NULL")
   Else
    ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'")
   End If
  Else
   ERWARTETERERTRAG = TErtragsgrenze
  End If
  If IsNull(ERWARTETERERTRAG) Then
   ERWARTETERERTRAG = 7500
  End If
  rs1!ERWARTETERERTRAG = ERWARTETERERTRAG
  rs1.Update
  rs1.MoveNext
 Else
  ' Step to next equal SNR
  If rs1!MGNR = rs2!MGNR Then
  
   If (rs1!SNR < rs2!SNR1) Then
     rs1.MoveNext
   Else
     rs2.MoveNext
   End If
  Else
  ' Step to next equal MGNR
   If (rs1!MGNR < rs2!MGNR) Then
     rs1.MoveNext
   Else
     rs2.MoveNext
   End If
  End If
  
 End If
 

 
Wend


End Sub