523 lines
16 KiB
QBasic
523 lines
16 KiB
QBasic
Option Compare Database
|
|
Option Explicit
|
|
|
|
Sub GebundenBerechnen(Jahr1 As Long, SortenattributeBeiFlächenbindungOptional As Boolean, GebundenBerücksichtigen As Boolean)
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim rs2 As Recordset
|
|
Dim rs3 As Recordset
|
|
|
|
Dim actMGNR As Long
|
|
Dim actSNR As String
|
|
Dim actSANR As String
|
|
Dim rsSANR As String
|
|
Dim actLieferrecht As Double
|
|
Dim actLieferrecht_Attribute(0 To 255) As Double
|
|
Dim actLieferungGebunden As Double
|
|
Dim actBetrag As Double
|
|
Dim GewichtGebunden As Double
|
|
Dim GewichtGebundenGrundsorte As Double
|
|
Dim test1
|
|
|
|
|
|
Dim ErgebnisGewicht As Double
|
|
Dim ErgebnisBetrag As Double
|
|
Dim ErgebnisGebunden As Double
|
|
Dim ErgebnisDatensaetze As Double
|
|
Dim ErgebnisAktDatensatz As Double
|
|
|
|
Dim query1 As String
|
|
Dim query2 As String
|
|
Dim zwi
|
|
Dim maxertrag As Double
|
|
Dim KgProHa
|
|
Dim attribute_count As Long
|
|
Dim i As Long
|
|
Dim j As Long
|
|
Dim ImmerUngebunden As Boolean
|
|
|
|
|
|
|
|
DoCmd.Hourglass True
|
|
|
|
|
|
'maxertrag = GetParameter("MAXERTRAG")
|
|
|
|
Set db1 = CurrentDb
|
|
|
|
query1 = "SELECT * FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(Jahr1) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR;"
|
|
'query1 = "SELECT * FROM (TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR) LEFT JOIN TSortenAttribute ON TLieferungen.SANR = TSortenAttribute.SANR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(jahr1) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR;"
|
|
Set rs1 = db1.OpenRecordset(query1)
|
|
|
|
actMGNR = -1
|
|
actSNR = ""
|
|
actSANR = ""
|
|
|
|
|
|
While Not rs1.EOF
|
|
|
|
rs1.Edit
|
|
|
|
If actMGNR <> rs1![TLieferungen.MGNR] Then
|
|
' Nächstes Mitglied
|
|
actMGNR = rs1![TLieferungen.MGNR]
|
|
actSNR = "----"
|
|
actSANR = "----"
|
|
End If
|
|
|
|
If Not IsNull(rs1![SANR]) And rs1!SANR <> "" Then
|
|
rsSANR = UCase(rs1![SANR])
|
|
ImmerUngebunden = DFirst("ImmerUngebunden", "TSortenAttribute", "SANR='" + rsSANR + "'")
|
|
Else
|
|
rsSANR = ""
|
|
ImmerUngebunden = False
|
|
End If
|
|
|
|
GewichtGebunden = 0
|
|
GewichtGebundenGrundsorte = 0
|
|
|
|
If SortenattributeBeiFlächenbindungOptional = True Then
|
|
|
|
'A Sortenattribute in Flaechenbindung optional
|
|
|
|
actSANR = rsSANR
|
|
|
|
'Feststellen der Lieferrechte bei Sortenwechsel
|
|
If actSNR <> UCase(rs1![TLieferungen.SNR]) Then
|
|
|
|
actSNR = UCase(rs1![TLieferungen.SNR])
|
|
|
|
KgProHa = DFirst("kgproHa", "TSorten", "SNR='" + actSNR + "'")
|
|
|
|
'maxertrag für Grundsorte bestimmen
|
|
If Not IsNull(KgProHa) And KgProHa > 0 Then
|
|
maxertrag = KgProHa
|
|
Else
|
|
maxertrag = GetParameter("MAXERTRAG")
|
|
End If
|
|
|
|
'Lieferrecht für Grundsorte errechnen
|
|
zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))")
|
|
If IsNull(zwi) Then
|
|
actLieferrecht = 0
|
|
zwi = 0
|
|
Else
|
|
actLieferrecht = zwi * maxertrag / 10000
|
|
End If
|
|
|
|
'maxertrag für jedes Attribut bestimmen
|
|
Set rs3 = db1.OpenRecordset("SELECT * FROM TSortenattribute ORDER BY SANR")
|
|
i = 0
|
|
While Not rs3.EOF
|
|
KgProHa = rs3("kgproha")
|
|
If Not IsNull(KgProHa) And KgProHa > 0 Then
|
|
actLieferrecht_Attribute(i) = zwi * KgProHa / 10000
|
|
Else
|
|
actLieferrecht_Attribute(i) = zwi * GetParameter("MAXERTRAG") / 10000
|
|
End If
|
|
rs3.MoveNext
|
|
i = i + 1
|
|
Wend
|
|
rs3.Close
|
|
attribute_count = i
|
|
End If
|
|
|
|
|
|
If rs1!QSNR >= 3 And (rs1!gebunden = True Or GebundenBerücksichtigen = False) Then
|
|
|
|
If actSANR = "" Then
|
|
'Grundsorte
|
|
|
|
If rs1!Gewicht < actLieferrecht Then
|
|
' Alles
|
|
GewichtGebunden = rs1!Gewicht
|
|
actLieferrecht = actLieferrecht - GewichtGebunden
|
|
|
|
'auch für alle Attribute Lieferrecht reduzieren
|
|
For i = 0 To attribute_count - 1
|
|
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
|
Next i
|
|
|
|
Else
|
|
If actLieferrecht > 0 Then
|
|
' Ein Teil
|
|
GewichtGebunden = actLieferrecht
|
|
actLieferrecht = 0
|
|
'auch für alle Attribute Lieferrecht reduzieren
|
|
For i = 0 To attribute_count - 1
|
|
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
|
Next i
|
|
|
|
Else
|
|
' Kein geb. Lieferrecht mehr übrig
|
|
GewichtGebunden = 0
|
|
End If
|
|
End If
|
|
Else
|
|
'Sortenattribut
|
|
|
|
'Nur wenn Attribut nicht ohnehin Ungebunden
|
|
If ImmerUngebunden = False Then
|
|
|
|
'richtigen Eintrag finden
|
|
Set rs3 = db1.OpenRecordset("SELECT * FROM TSortenattribute ORDER BY SANR")
|
|
j = 0
|
|
While Not rs3.EOF And rs3("SANR") <> actSANR
|
|
rs3.MoveNext
|
|
j = j + 1
|
|
Wend
|
|
rs3.Close
|
|
If j > attribute_count Then
|
|
'error
|
|
MsgBox ("Fehler bei Attributen!")
|
|
End If
|
|
|
|
If rs1!Gewicht < actLieferrecht_Attribute(j) Then
|
|
' Alles
|
|
GewichtGebunden = rs1!Gewicht
|
|
actLieferrecht = actLieferrecht - GewichtGebunden
|
|
|
|
'auch für alle Attribute Lieferrecht reduzieren
|
|
For i = 0 To attribute_count - 1
|
|
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
|
Next i
|
|
|
|
Else
|
|
If actLieferrecht_Attribute(j) > 0 Then
|
|
' Ein Teil
|
|
GewichtGebunden = actLieferrecht_Attribute(j)
|
|
'Lieferrecht bei Grundsorte reduzieren
|
|
actLieferrecht = actLieferrecht - GewichtGebunden
|
|
'auch für alle Attribute Lieferrecht reduzieren
|
|
For i = 0 To attribute_count - 1
|
|
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
|
Next i
|
|
|
|
Else
|
|
' Kein geb. Lieferrecht mehr übrig
|
|
GewichtGebunden = 0
|
|
End If
|
|
End If
|
|
|
|
'Versuche, Rest auf Grundsorte zu verbuchen
|
|
If GewichtGebunden < rs1!Gewicht And actLieferrecht > 0 Then
|
|
|
|
If rs1!Gewicht - GewichtGebunden < actLieferrecht Then
|
|
' Alles
|
|
GewichtGebundenGrundsorte = rs1!Gewicht - GewichtGebunden
|
|
actLieferrecht = actLieferrecht - GewichtGebundenGrundsorte
|
|
|
|
'auch für alle Attribute Lieferrecht reduzieren
|
|
For i = 0 To attribute_count - 1
|
|
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebundenGrundsorte
|
|
Next i
|
|
|
|
Else
|
|
If actLieferrecht > 0 Then
|
|
' Ein Teil
|
|
GewichtGebundenGrundsorte = actLieferrecht
|
|
actLieferrecht = 0
|
|
'auch für alle Attribute Lieferrecht reduzieren
|
|
For i = 0 To attribute_count - 1
|
|
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebundenGrundsorte
|
|
Next i
|
|
|
|
Else
|
|
' Kein geb. Lieferrecht mehr übrig
|
|
GewichtGebundenGrundsorte = 0
|
|
End If
|
|
End If
|
|
|
|
|
|
End If
|
|
|
|
End If
|
|
|
|
End If
|
|
|
|
Else
|
|
' Kein Qualitätswein
|
|
GewichtGebunden = 0
|
|
End If
|
|
|
|
|
|
'MsgBox (Format(rs1!Gewicht) + " " + Format(rs1!Gebunden) + " " + Format(GewichtGebunden))
|
|
|
|
If IsNull(GewichtGebunden) Then GewichtGebunden = 0
|
|
If IsNull(GewichtGebundenGrundsorte) Then GewichtGebundenGrundsorte = 0
|
|
|
|
'rounding
|
|
If CLng(GewichtGebunden) < GewichtGebunden Then
|
|
GewichtGebunden = CLng(GewichtGebunden) + 1
|
|
Else
|
|
GewichtGebunden = CLng(GewichtGebunden)
|
|
End If
|
|
GewichtGebundenGrundsorte = Int(GewichtGebundenGrundsorte)
|
|
|
|
|
|
rs1!BGewichtGebunden = GewichtGebunden
|
|
rs1!BGewichtGebundenGrundsorte = GewichtGebundenGrundsorte
|
|
|
|
rs1.Update
|
|
|
|
|
|
Else
|
|
'B Strikt = Sortenattribute in Flaechenbindung NICHT optional
|
|
|
|
'Feststellen der Lieferrechte bei Sorten oder Attributswechsel
|
|
If actSNR <> UCase(rs1![TLieferungen.SNR]) Or (actSANR <> rsSANR) Then
|
|
' Nächste Sorte oder Attribut
|
|
actSNR = UCase(rs1![TLieferungen.SNR])
|
|
actSANR = rsSANR
|
|
|
|
'maxertrag setzen
|
|
If actSANR <> "" Then
|
|
'from Sortenattribut
|
|
KgProHa = DFirst("kgproHa", "TSortenattribute", "SANR='" + rsSANR + "'")
|
|
If Not IsNull(KgProHa) And KgProHa > 0 Then
|
|
maxertrag = KgProHa
|
|
Else
|
|
maxertrag = GetParameter("MAXERTRAG")
|
|
End If
|
|
zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND SANR='" + actSANR + "' AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") * maxertrag / 10000
|
|
Else
|
|
'from Sorte
|
|
If Not IsNull(rs1!KgProHa) And rs1!KgProHa > 0 Then
|
|
maxertrag = rs1!KgProHa
|
|
Else
|
|
maxertrag = GetParameter("MAXERTRAG")
|
|
End If
|
|
zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND (Isnull(SANR) or SANR='') AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") * maxertrag / 10000
|
|
End If
|
|
|
|
|
|
If IsNull(zwi) Then
|
|
actLieferrecht = 0
|
|
Else
|
|
actLieferrecht = zwi
|
|
End If
|
|
actLieferungGebunden = 0
|
|
End If
|
|
|
|
' actLieferungGewicht
|
|
|
|
|
|
|
|
'Wieviel ist gebunden ?
|
|
|
|
|
|
If rs1!QSNR >= 3 And (rs1!gebunden = True Or GebundenBerücksichtigen = False) And ImmerUngebunden = False Then
|
|
|
|
If rs1!Gewicht < actLieferrecht - actLieferungGebunden Then
|
|
' Alles
|
|
GewichtGebunden = rs1!Gewicht
|
|
actLieferungGebunden = actLieferungGebunden + GewichtGebunden
|
|
Else
|
|
If actLieferungGebunden < actLieferrecht Then
|
|
' Ein Teil
|
|
GewichtGebunden = actLieferrecht - actLieferungGebunden
|
|
actLieferungGebunden = actLieferrecht
|
|
Else
|
|
' Kein geb. Lieferrecht mehr übrig
|
|
GewichtGebunden = 0
|
|
End If
|
|
End If
|
|
Else
|
|
' Kein Qualitätswein
|
|
GewichtGebunden = 0
|
|
End If
|
|
|
|
|
|
'MsgBox (Format(rs1!Gewicht) + " " + Format(rs1!Gebunden) + " " + Format(GewichtGebunden))
|
|
|
|
If IsNull(GewichtGebunden) Then GewichtGebunden = 0
|
|
|
|
'round up
|
|
If CLng(GewichtGebunden) < GewichtGebunden Then
|
|
GewichtGebunden = CLng(GewichtGebunden) + 1
|
|
Else
|
|
GewichtGebunden = CLng(GewichtGebunden)
|
|
End If
|
|
|
|
rs1!BGewichtGebunden = GewichtGebunden
|
|
rs1!BGewichtGebundenGrundsorte = 0
|
|
rs1.Update
|
|
|
|
End If
|
|
|
|
rs1.MoveNext
|
|
|
|
Wend
|
|
|
|
rs1.Close
|
|
|
|
|
|
|
|
DoCmd.Hourglass False
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
Sub Auszahlung2015_MwStUmstellen()
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim rs2 As Recordset
|
|
Dim faktor As Double
|
|
Dim Buchführend As Boolean
|
|
Dim summe1 As Double
|
|
Dim summe2 As Double
|
|
|
|
|
|
Set db1 = CurrentDb
|
|
|
|
'1. originaldaten sichern
|
|
db1.Execute ("DROP TABLE xTempLieferungen")
|
|
db1.Execute ("CREATE TABLE xTempLieferungen (LINR Integer, MGNR Integer, BTeilzahlung1 DOUBLE, BBetragGebunden DOUBLE, BBetragUngebunden DOUBLE,BTeilzahlung1_neu DOUBLE, BBetragGebunden_neu DOUBLE, BBetragUngebunden_neu DOUBLE, Korrekturbetrag DOUBLE,GesamtBrutto DOUBLE, GesamtBrutto_neu DOUBLE, GesamtBrutto_neu_korrigiert DOUBLE)")
|
|
db1.Execute ("DELETE * FROM xTempLieferungen")
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungen where datum>Datevalue('01.01.2015') order by LINR")
|
|
Set rs2 = db1.OpenRecordset("xTempLieferungen")
|
|
|
|
While Not rs1.EOF
|
|
rs2.AddNew
|
|
rs2("LINR") = rs1("LINR")
|
|
rs2("MGNR") = rs1("MGNR")
|
|
rs2("BTeilzahlung1") = rs1("BTeilzahlung1")
|
|
rs2("BBetragGebunden") = rs1("BBetragGebunden")
|
|
rs2("BBetragUngebunden") = rs1("BBetragUngebunden")
|
|
rs2.Update
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
rs2.Close
|
|
|
|
'2. nettobeträge korrigieren
|
|
Set rs1 = db1.OpenRecordset("SELECT TLieferungen.* FROM TLieferungen WHERE MGNR>0 AND datum>Datevalue('01.01.2015') order by LINR")
|
|
While Not rs1.EOF
|
|
Buchführend = DFirst("Buchführend", "TMitglieder", "MGNR=" + Format(rs1("MGNR")))
|
|
'If buchführend Then
|
|
' faktor = 1
|
|
'Else
|
|
faktor = 1.13 / 1.12
|
|
'End If
|
|
Set rs2 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE LINR=" + Format(rs1("LINR")))
|
|
rs2.Edit
|
|
rs2("BTeilzahlung1_neu") = rs1("BTeilzahlung1") * faktor
|
|
rs2("BBetragGebunden_neu") = rs1("BBetragGebunden") * faktor
|
|
rs2("BBetragUngebunden_neu") = rs1("BBetragUngebunden") * faktor
|
|
rs2("Korrekturbetrag") = 0
|
|
rs2.Update
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
rs2.Close
|
|
|
|
'3. runden für gleichen Betrag
|
|
Set rs1 = db1.OpenRecordset("SELECT DISTINCT MGNR FROM TLieferungen WHERE MGNR>0 AND MGNR NOT IN (SELECT MGNR FROM TMitglieder WHERE Buchführend=True) AND datum>Datevalue('01.01.2015') order by MGNR")
|
|
While Not rs1.EOF
|
|
|
|
summe1 = DSum("BTeilzahlung1", "xTempLieferungen", "MGNR=" + Format(rs1("MGNR")))
|
|
summe2 = 0
|
|
If summe1 <> 0 Then
|
|
Set rs2 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE MGNR=" + Format(rs1("MGNR")))
|
|
|
|
While Not rs2.EOF
|
|
|
|
rs2.Edit
|
|
rs2("BTeilzahlung1_neu") = Runden(rs2("BTeilzahlung1_neu"), 2)
|
|
If Not IsNull(rs2("BBetragGebunden_neu")) Then
|
|
rs2("BBetragGebunden_neu") = Runden(rs2("BBetragGebunden_neu"), 3)
|
|
End If
|
|
If Not IsNull(rs2("BBetragUngebunden_neu")) Then
|
|
rs2("BBetragUngebunden_neu") = Runden(rs2("BBetragUngebunden_neu"), 3)
|
|
End If
|
|
summe2 = summe2 + rs2("BTEilzahlung1_neu")
|
|
rs2.Update
|
|
rs2.MoveNext
|
|
Wend
|
|
rs2.MovePrevious
|
|
'letzten Eintrag auf korrekte Summe korrigieren
|
|
rs2.Edit
|
|
'rs2("Korrekturbetrag") = (summe2 * 1.12 - summe1 * 1.13) / 1.12
|
|
rs2("Korrekturbetrag") = Runden((Runden(summe2 * 1.12, 2) - Runden(summe1 * 1.13, 2)) / 1.12, 2)
|
|
rs2("GesamtBrutto") = Runden(summe1 * 1.13, 2)
|
|
rs2("GesamtBrutto_neu") = Runden(summe2 * 1.12, 2)
|
|
rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2)
|
|
|
|
If rs2("GesamtBrutto_neu_korrigiert") > rs2("GesamtBrutto") Then
|
|
rs2("Korrekturbetrag") = rs2("Korrekturbetrag") + 0.01
|
|
rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2)
|
|
End If
|
|
If rs2("GesamtBrutto_neu_korrigiert") < rs2("GesamtBrutto") Then
|
|
rs2("Korrekturbetrag") = rs2("Korrekturbetrag") - 0.01
|
|
rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2)
|
|
End If
|
|
rs2.Update
|
|
|
|
rs2.Close
|
|
|
|
End If
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
|
|
'Exit Sub
|
|
'4. Rückübertragung in TLieferungen
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE BTeilzahlung1>0 ORDER BY LINR")
|
|
While Not rs1.EOF
|
|
Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen where LINR=" + Format(rs1("LINR")))
|
|
If Not rs2.EOF Then
|
|
rs2.Edit
|
|
rs2("BTeilzahlung1") = Runden(rs1("BTeilzahlung1_neu") - rs1("Korrekturbetrag"), 2)
|
|
rs2("BBetragGebunden") = rs1("BBetragGebunden_neu")
|
|
rs2("BBetragUngebunden") = rs1("BBetragUngebunden_neu")
|
|
rs2.Update
|
|
End If
|
|
rs2.Close
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
|
|
End Sub
|
|
|
|
|
|
Sub Auszahlung2015_NettoPreiseProKg_anheben()
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
|
|
Dim faktor As Double
|
|
|
|
Set db1 = CurrentDb
|
|
faktor = 1.13 / 1.12
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=140")
|
|
While Not rs1.EOF
|
|
rs1.Edit
|
|
If Not IsNull(rs1("Betrag")) Then
|
|
rs1("Betrag") = Runden(faktor * rs1("Betrag"), 3)
|
|
End If
|
|
rs1.Update
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSortenQualitätsstufe WHERE AZNR=140")
|
|
While Not rs1.EOF
|
|
rs1.Edit
|
|
If Not IsNull(rs1("Betrag")) Then
|
|
rs1("Betrag") = Runden(faktor * rs1("Betrag"), 3)
|
|
End If
|
|
rs1.Update
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
|
|
|
|
|
|
End Sub
|
|
|