288 lines
6.5 KiB
Plaintext
288 lines
6.5 KiB
Plaintext
|
|
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
|