winzer/elwig-misc
3
1
Fork 0
Code Pull Requests Activity
Files
2603da55374b0ab46c20d0e5f2f08f95360a64a9
elwig-misc/wgmaster/vba/form/Form_FAuszahlung.frm

1171 lines
37 KiB
Plaintext
Raw Blame History

Private Sub BAddieren_Click()
Dim konst1
If Not IsNull(Forms!FAuszahlung!TSNR) Then
konst1 = InputBox("Welchen Wert wollen Sie zu allen Qualitätszuschläge der ausgewählten Sorte addieren ?")
If Not IsNull(konst1) Then
Dim db1 As Database
Dim rs1 As Recordset
Set db1 = CurrentDb
If IsNull(TSANR) Then
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND Isnull(SANR)")
Else
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND SANR='" + TSANR + "'")
End If
While Not rs1.EOF
rs1.Edit
rs1!Betrag = rs1!Betrag + konst1
rs1.Update
rs1.MoveNext
Wend
rs1.Close
FUnter1.Requery
End If
End If
End Sub
Function GetFilter()
Dim filter1 As String
If IsNull(TZNR) Then
filter1 = "Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr)
Else
filter1 = "Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr) + " AND ZNR=" + Forms!FAuszahlung!TZNR
End If
If Not IsNull(TVon) And Not IsNull(TBis) Then
filter1 = filter1 + " AND "
If OSortierung = 1 Then
' sort by mgnr
filter1 = filter1 + "MGNR>=" + Format(TVon) + " AND MGNR<=" + Format(TBis)
Else
' sort by plz
filter1 = filter1 + "PLZ>='" + Format(TVon) + "' AND PLZ<= '" + Format(TBis) + "'"
End If
End If
GetFilter = filter1
End Function
Private Sub BAuszahlungDrucken_Click()
Dim filter1
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
If IsNull(TFusstext.Value) Then
SetParameter "AUSZAHLUNGTEXT", " "
Else
SetParameter "AUSZAHLUNGTEXT", TFusstext.Value
End If
If IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_BF")) Then
SetParameter "AUSZAHLUNGZUSATZTEXT_BF", " "
End If
If IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_PA")) Then
SetParameter "AUSZAHLUNGZUSATZTEXT_PA", " "
End If
filter1 = GetFilter
'filter1 = "SELECT * FROM TLieferungen WHERE " + filter1
'MsgBox (getfilter)
DoCmd.Maximize
Select Case OSortierung
Case 1:
DoCmd.OpenReport "BAuszahlungMGNR", acPreview, , filter1
Case 2:
DoCmd.OpenReport "BAuszahlung", acPreview, , filter1
End Select
End Sub
Private Sub BBerechnen_Click()
If IsNull(TLesejahr) Or TLesejahr < 1900 Then
MsgBox ("Bitte zuerst das Lesejahr eingeben !")
TLesejahr.SetFocus
Exit Sub
End If
Select Case Forms!FAuszahlung!TZahlungNr
Case 1:
If DSum("BTeilzahlung1", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 1.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Case 2:
If DSum("BTeilzahlung2", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 2.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Case 3:
If DSum("BTeilzahlung3", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 3.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Case 4:
If DSum("BTeilzahlung4", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 4.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Case 5:
If DSum("BTeilzahlung5", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 5.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Case 6:
If DSum("BEndauszahlung", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine Endauszahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
End Select
If MsgBox("Dieser Vorgang kann länger dauern ! Fortfahren ?", vbYesNo) = vbYes Then
DoCmd.Hourglass True
'1. Gebunden/Gebunden Grundsorte/Ungebunden bestimmen
GebundenBerechnen TLesejahr, OSortenAttributInFlaechenbindungOptional, OGebunden
'2. Berechnen der Tarife f. alle Lieferungen
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim GewichtGebunden As Double
Dim GewichtGebundenGrundsorte As Double
Dim ErgebnisGewicht As Double
Dim ErgebnisBetrag As Double
Dim ErgebnisGebunden As Double
Dim ErgebnisDatensaetze As Double
Dim ErgebnisAktDatensatz As Double
Dim GB As Double ' Grundbetrag
Dim GZS As Double ' Gebundenzuschlag
Dim GZS_SQ As Double ' Gebundenzuschlag sorten/qualitätsabhängig
Dim SQZS As Double ' Sorten/Qualitätszuschlag
Dim QSZS As Double 'Qualitätsstufenzuschlag
Dim GZS_SQ_Grundsorte As Double
Dim SQZS_Grundsorte As Double
Dim ZSZS As Double ' Zweigstellenzuschlag
Dim RIZS As Double ' Riedzuschlag
Dim GEZS As Double ' Gemeindezuschlag
Dim GRZS As Double ' Großlagenzuschlag
Dim WEZS As Double ' Weinbaugebietszuschlag
Dim REZS As Double ' Regionzuschlag
Dim REBELFAKT As Double
Dim AZAS As Double ' Abschläge
Dim BetragProKgUngebunden As Double
Dim BetragProKgGebunden As Double
Dim BetragProKgGebundenGrundsorte As Double
Dim query1 As String
Dim query2 As String
Dim gesamtpunkte_gebunden As Double
Dim gesamtpunkte_ungebunden As Double
Dim gesamtpunkte_gebunden_grundsorte As Double
Dim actBetrag As Double
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(Forms!FAuszahlung!TLesejahr) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR"
Set rs1 = db1.OpenRecordset(query1) 'Lieferungen
If IsNull(TGB) Then
GB = 0
Else
GB = TGB
End If
If IsNull(TGBZS) Then
GZS = 0
Else
GZS = TGBZS
End If
ErgebnisGewicht = 0
ErgebnisBetrag = 0
ErgebnisGebunden = 0
ErgebnisDatensaetze = 0
ErgebnisAktDatensatz = 0
While Not rs1.EOF
ZSZS = 0
RIZS = 0
GEZS = 0
GRZS = 0
WEZS = 0
REZS = 0
rs1.Edit
' Gebunden
GewichtGebunden = rs1("BGewichtGebunden")
GewichtGebundenGrundsorte = rs1("BGewichtGebundenGrundsorte")
' Qualitätsstufenzuschlag
'If rs1("LINR") = 178227 Then
' MsgBox ("Lieferung gefunden")
'End If
If IsNull(rs1("SANR")) Or rs1("SANR") = "" Then
query2 = "SELECT Betrag AS QSZS,TAuszahlungSortenQualitätsstufe.SNR,TAuszahlungSortenQualitätsstufe.SANR FROM TAuszahlungSortenQualitätsstufe INNER JOIN TLieferungen ON (TAuszahlungSortenQualitätsstufe.SNR = TLieferungen.SNR AND TAuszahlungSortenQualitätsstufe.QSNR=TLieferungen.QSNR) WHERE (TAuszahlungSortenQualitätsstufe.SANR IS NULL or TAuszahlungSortenQualitätsstufe.SANR='') AND AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TLieferungen.LINR=" + Format(rs1("LINR"))
'query2 = "SELECT Betrag AS QSZS,TAuszahlungSortenQualitätsstufe.SNR,TAuszahlungSortenQualitätsstufe.SANR FROM TAuszahlungSortenQualitätsstufe INNER JOIN TLieferungen ON (TAuszahlungSortenQualitätsstufe.SNR = TLieferungen.SNR AND TAuszahlungSortenQualitätsstufe.QSNR=TLieferungen.QSNR) WHERE TAuszahlungSortenQualitätsstufe.SANR IS NULL AND AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TLieferungen.LINR=" + Format(rs1("LINR"))
Else
query2 = "SELECT Betrag AS QSZS, TAuszahlungSortenQualitätsstufe.SNR, TAuszahlungSortenQualitätsstufe.SANR FROM TAuszahlungSortenQualitätsstufe INNER JOIN TLieferungen ON (TAuszahlungSortenQualitätsstufe.SNR = TLieferungen.SNR AND TAuszahlungSortenQualitätsstufe.QSNR=TLieferungen.QSNR AND TAuszahlungSortenQualitätsstufe.SANR=TLieferungen.SANR) WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TLieferungen.LINR=" + Format(rs1("LINR"))
End If
Set rs2 = db1.OpenRecordset(query2)
' Falls ein Qualitätsstufenzuschlag gefunden wird, wird der Sorten & Qualitätszuschlag nicht angewendet!
If Not rs2.EOF Then
'1. Qualitätsstufenzuschlag gefunden
rs2.MoveLast
'If rs2(1) = "BP" And IsNull(rs1("SANR")) Then
' MsgBox (rs2.recordcount)
' MsgBox (rs2(2))
'End If
QSZS = rs2("QSZS")
rs2.Close
SQZS = 0
SQZS_Grundsorte = 0
'Kein Gebundenzuschlag
GZS = 0
GZS_SQ = 0
Else
QSZS = 0
rs2.Close
'2. Kein Qualitätsstufenzuschlag gefunden
' Sorten- und Qualitätszuschlag anwenden
'Anfrage für genau diese Sorte und OriginalOechsle und ungebunden
If IsNull(rs1("SANR")) Or rs1("SANR") = "" Then
query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=False AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')"
Else
query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) AND (TAuszahlungSorten.SANR = TLieferungen.SANR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=False AND TLieferungen.LINR=" + Format(rs1("LINR"))
End If
Set rs2 = db1.OpenRecordset(query2)
If rs2.EOF Then
MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (ungebunden)! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
SQZS = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR))
rs2.MoveLast
If rs2.recordcount > 1 Then
MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
rs2.Close
'Grundsorte
query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=False AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')"
Set rs2 = db1.OpenRecordset(query2)
If rs2.EOF Then
MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (ungebunden)! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
SQZS_Grundsorte = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR))
rs2.MoveLast
If rs2.recordcount > 1 Then
MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
rs2.Close
' Gebundenzuschlag Sorten/Qualitätsabhängig
'Anfrage für genau diese Sorte und Oechsle und gebunden
If IsNull(rs1("SANR")) Or rs1("SANR") = "" Then
query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=True AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')"
Else
query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) AND (TAuszahlungSorten.SANR = TLieferungen.SANR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=True AND TLieferungen.LINR=" + Format(rs1("LINR"))
End If
Set rs2 = db1.OpenRecordset(query2)
If rs2.EOF Then
MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1(SNR) + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
GZS_SQ = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR))
rs2.MoveLast
If rs2.recordcount > 1 Then
MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
rs2.Close
GZS_SQ = GZS_SQ - SQZS
'Grundsorte
query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=True AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')"
Set rs2 = db1.OpenRecordset(query2)
If rs2.EOF Then
MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1(SNR) + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
GZS_SQ_Grundsorte = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR))
rs2.MoveLast
If rs2.recordcount > 1 Then
MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical
rs2.Close
rs1.Close
Exit Sub
End If
rs2.Close
GZS_SQ_Grundsorte = GZS_SQ_Grundsorte - SQZS_Grundsorte
End If
If OZWZS Then
' Zweigstellenzuschlag: ZNR ist nicht Stammzweigstelle des Mitglieds
If rs1![TMitglieder.ZNR] <> rs1![TLieferungen.ZNR] Then
ZSZS = DFirst("ZSZS", "TZweigstellen", "ZNR=" + Format(rs1![TLieferungen.ZNR]))
End If
End If
If ORIZS Then
' Riedzuschlag
If Not IsNull(rs1!RNR) Then
RIZS = DFirst("RZS", "TRiede", "RNR=" + Format(rs1!RNR))
End If
End If
If OGEZS Then
' Gemeindezuschlag
If Not IsNull(rs1!GNR) Then
GEZS = DFirst("GZS", "TGemeinden", "GNR=" + Format(rs1!GNR))
End If
End If
If OGRZS Then
' Großlagenzuschlag
If Not IsNull(rs1!GNR) Then
query1 = "SELECT * FROM TGrosslagen INNER JOIN TGemeinden ON TGrosslagen.GLNR = TGemeinden.GLNR WHERE GNR=" + Format(rs1!GNR)
Set rs3 = db1.OpenRecordset(query1)
GRZS = rs3!GLZS
rs3.Close
End If
End If
If OWEZS Then
' Gebietszuschlag
If Not IsNull(rs1!GNR) Then
query1 = "SELECT * FROM TGebiete INNER JOIN (TGrosslagen INNER JOIN TGemeinden ON TGrosslagen.GLNR = TGemeinden.GLNR) ON TGebiete.WBGNR = TGrosslagen.WBGNR WHERE GNR=" + Format(rs1!GNR)
Set rs3 = db1.OpenRecordset(query1)
WEZS = rs3!WBGZS
rs3.Close
End If
End If
If OREZS Then
' Regionzuschlag
If Not IsNull(rs1!GNR) Then
query1 = "SELECT * FROM TRegionen INNER JOIN (TGebiete INNER JOIN (TGrosslagen INNER JOIN TGemeinden ON TGrosslagen.GLNR = TGemeinden.GLNR) ON TGebiete.WBGNR = TGrosslagen.WBGNR) ON TRegionen.RGNR = TGebiete.RGNR WHERE GNR=" + Format(rs1!GNR)
Set rs3 = db1.OpenRecordset(query1)
REZS = rs3!RZS
rs3.Close
End If
End If
'Volllieferantenzuschlag
If rs1!Volllieferant = True Then
VLZS = TAufschlagVolllieferant
'MsgBox (rs1![TMitglieder.MGNR])
If IsNull(VLZS) Then VLZS = 0
Else
VLZS = 0
End If
REBELFAKT = 1
' Gerebelt bzw. Rebelfaktor
If IsNull(TRebelzuschlag) Then TRebelzuschlag = 0
rs1!BRebelzuschlag = 0
If Not IsNull(TRebelzuschlag) And rs1!Gerebelt = True Then
REBELFAKT = (100 + TRebelzuschlag) / 100
rs1!BRebelzuschlag = TRebelzuschlag
End If
'Zu-/Abschläge absolut
If OAZAS Then
query1 = "SELECT TAbschlaege.* FROM TAbschlaege INNER JOIN TLieferungAbschlag ON TAbschlaege.ASNR = TLieferungAbschlag.ASNR WHERE LINR=" + Format(rs1!LINR)
AZAS = 0
Set rs3 = db1.OpenRecordset(query1)
While Not rs3.EOF
If Not IsNull(rs3!AZAS) Then
AZAS = AZAS + rs3!AZAS
End If
rs3.MoveNext
Wend
rs3.Close
End If
' Berechnung der Beträge pro kg
'If GZS < 0 Or GZS_SQ < 0 Then
' MsgBox ("GZS oder GZS_SQ<0")
' MsgBox (rs1!LINR)
'End If
BetragProKgUngebunden = (GB + QSZS + SQZS + ZSZS + RIZS + GEZS + GRZS + WEZS + REZS + VLZS + AZAS)
'2.1.2012: Falls Qualitätsstufenzuschlag zum Tragen kommt gibt es keinen gebundenen Tarif.
If QSZS > 0 Then
BetragProKgGebunden = 0
Else
BetragProKgGebunden = BetragProKgUngebunden + GZS + GZS_SQ
End If
BetragProKgGebundenGrundsorte = (GB + SQZS_Grundsorte + ZSZS + RIZS + GEZS + GRZS + WEZS + REZS + VLZS + AZAS) + GZS + GZS_SQ_Grundsorte
'Zu-/Abschläge %
ABSCHLAGFAKTOR = 1
If OAZAS Then
query1 = "SELECT TAbschlaege.* FROM TAbschlaege INNER JOIN TLieferungAbschlag ON TAbschlaege.ASNR = TLieferungAbschlag.ASNR WHERE LINR=" + Format(rs1!LINR)
Set rs3 = db1.OpenRecordset(query1)
While Not rs3.EOF
If Not IsNull(rs3!AZASProzent) Then
ABSCHLAGFAKTOR = ABSCHLAGFAKTOR * (100 + rs3!AZASProzent) / 100
End If
rs3.MoveNext
Wend
rs3.Close
End If
BetragProKgUngebunden = BetragProKgUngebunden * ABSCHLAGFAKTOR
BetragProKgGebunden = BetragProKgGebunden * ABSCHLAGFAKTOR
BetragProKgGebundenGrundsorte = BetragProKgGebundenGrundsorte * ABSCHLAGFAKTOR
gesamtpunkte_gebunden = BetragProKgGebunden
gesamtpunkte_gebunden_grundsorte = BetragProKgGebundenGrundsorte
gesamtpunkte_ungebunden = BetragProKgUngebunden
' Berücksichtigung des Ausgabefaktors
If IsNull(TAusgabefaktor) Then TAusgabefaktor = 1
BetragProKgUngebunden = BetragProKgUngebunden * TAusgabefaktor
BetragProKgGebunden = BetragProKgGebunden * TAusgabefaktor
BetragProKgGebundenGrundsorte = BetragProKgGebundenGrundsorte * TAusgabefaktor
' Rundung der Beträge pro kg
BetragProKgUngebunden = Runden(BetragProKgUngebunden, 3)
BetragProKgGebunden = Runden(BetragProKgGebunden, 3)
BetragProKgGebundenGrundsorte = Runden(BetragProKgGebundenGrundsorte, 3)
' Berechnung von actBetrag
If Not IsNull(rs1!Gewicht) Then
actBetrag = (rs1!Gewicht - GewichtGebunden - GewichtGebundenGrundsorte) * REBELFAKT * BetragProKgUngebunden + REBELFAKT * GewichtGebunden * BetragProKgGebunden + REBELFAKT * GewichtGebundenGrundsorte * BetragProKgGebundenGrundsorte
Else
actBetrag = 0
End If
'actBetrag Runden
'rs1!BProbeauszahlung = actBetrag
actBetrag = Runden(actBetrag, 2)
' Berechnete Felder aktualisieren
If IsNull(rs1!BTeilzahlung1) Then
rs1!BTeilzahlung1 = 0
End If
If IsNull(rs1!BTeilzahlung2) Then
rs1!BTeilzahlung2 = 0
End If
If IsNull(rs1!BTeilzahlung3) Then
rs1!BTeilzahlung3 = 0
End If
If IsNull(rs1!BTeilzahlung4) Then
rs1!BTeilzahlung4 = 0
End If
If IsNull(rs1!BTeilzahlung5) Then
rs1!BTeilzahlung5 = 0
End If
Select Case Forms!FAuszahlung!TZahlungNr
Case 1:
rs1!BTeilzahlung1 = actBetrag
Case 2:
rs1!BTeilzahlung2 = actBetrag
Case 3:
rs1!BTeilzahlung3 = actBetrag
Case 4:
rs1!BTeilzahlung4 = actBetrag
Case 5:
rs1!BTeilzahlung5 = actBetrag
Case 6:
rs1!BEndauszahlung = actBetrag
Case 7:
rs1!BProbeauszahlung = actBetrag
End Select
'BAbschlaegestring updaten
rs1!BAbschlaegeString = GetAbschlägeAsString(rs1!LINR)
'Gesamtpunkteanzahl
If TAusgabefaktor <> 1 Then
'nur wenn Ausgabefaktor ungleich 1
If (GewichtGebunden = rs1!Gewicht) Then
'alles Gebunden
rs1!BAbschlaegeString = Format(gesamtpunkte_gebunden) + " Punkte/kg " + rs1!BAbschlaegeString
Else
If (GewichtGebunden = 0) Then
'alles ungebunden
rs1!BAbschlaegeString = Format(gesamtpunkte_ungebunden) + " Punkte/kg " + rs1!BAbschlaegeString
Else
rs1!BAbschlaegeString = Format(gesamtpunkte_gebunden) + "/" + Format(gesamtpunkte_ungebunden) + " Punkte/kg " + rs1!BAbschlaegeString
End If
End If
End If
'rs1!BGewichtGebunden = GewichtGebunden
rs1!BBetragUngebunden = BetragProKgUngebunden
rs1!BBetragGebunden = BetragProKgGebunden
rs1!BBetragGebundenGrundsorte = BetragProKgGebundenGrundsorte
' BetragGebunden pro kg
test1 = rs1!Lieferscheinnummer
rs1.Update
' Ausgabe der laufenden Ergebnisse
If Not IsNull(rs1!Gewicht) Then
ErgebnisGewicht = ErgebnisGewicht + rs1!Gewicht
End If
ErgebnisBetrag = ErgebnisBetrag + actBetrag
ErgebnisGebunden = ErgebnisGebunden + GewichtGebunden + GewichtGebundenGrundsorte
ErgebnisDatensaetze = rs1.recordcount
ErgebnisAktDatensatz = ErgebnisAktDatensatz + 1
If ErgebnisAktDatensatz Mod 10 = 0 Then
TErgebnisGewicht = ErgebnisGewicht
TErgebnisBetrag = ErgebnisBetrag
TErgebnisGebunden = ErgebnisGebunden
TErgebnisDatensaetze = ErgebnisDatensaetze
TErgebnisAktDatensatz = ErgebnisAktDatensatz
DoEvents
End If
rs1.MoveNext
Wend
rs1.Close
End If
TErgebnisGewicht = ErgebnisGewicht
TErgebnisBetrag = ErgebnisBetrag
TErgebnisGebunden = ErgebnisGebunden
TErgebnisDatensaetze = ErgebnisDatensaetze
TErgebnisAktDatensatz = ErgebnisAktDatensatz
DoCmd.Hourglass False
End Sub
Private Sub Befehl285_Click()
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.Maximize
DoCmd.OpenReport "BUeberweisungsliste", acViewPreview
End Sub
Private Sub Befehl286_Click()
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.Maximize
DoCmd.OpenReport "BBuchungsliste", acViewPreview
End Sub
Private Sub Befehl301_Click()
MsgBox (OGebunden)
End Sub
Private Sub BExportExcel_Click()
Dim SEL1 As String
Dim GROUP1 As String
Dim where1 As String
Dim order1 As String
Dim query1
Dim savepath1
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
SEL1 = "SELECT DISTINCT TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1 AS Bank, TMitglieder.BHKontonummer, CCur(Sum(IIf([Formulare]![FAuszahlung]![TZahlungNr]=1,[BTeilzahlung1],IIf([Formulare]![FAuszahlung]![TZahlungNr]=2,[BTeilzahlung2],IIf([Formulare]![FAuszahlung]![TZahlungNr]=3,[BTeilzahlung3],IIf([Formulare]![FAuszahlung]![TZahlungNr]=4,[BTeilzahlung4],IIf([Formulare]![FAuszahlung]![TZahlungNr]=5,[BTeilzahlung5],IIf([Formulare]![FAuszahlung]![TZahlungNr]=6,[BEndauszahlung],[BProbeauszahlung])))))))) AS BetragNetto, First(IIf([Buchführend],Getparameter('MWST2'),GetPArameter('MWST1'))) AS MwStProzent, CCur(BetragNetto*MwStProzent/100) as MwStBetrag, CCur(BetragNetto*(MwStProzent+100)/100) as BetragBrutto"
SEL1 = SEL1 + " FROM TBanken RIGHT JOIN (TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ "
GROUP1 = " GROUP BY TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1, TMitglieder.BHKontonummer "
Select Case OSortierung
Case 1: order1 = " ORDER BY TMitglieder.MGNR "
Case 2: order1 = " ORDER BY TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.Nachname, TMitglieder.Vorname "
End Select
where1 = " WHERE Year(Datum)=" + Format(TLesejahr) + " AND Storniert=false "
If Not IsNull(TZNR) And TZNR <> "" Then
where1 = where1 + " AND TLieferungen.ZNR=" + Format(TZNR)
End If
If Not IsNull(TVon) And TVon >= 0 Then
If OSortierung = 1 Then
where1 = where1 + " AND TLieferungen.MGNR>=" + Format(TVon) + " "
Else
where1 = where1 + " AND TMitglieder.PLZ>=" + Format(TVon) + " "
End If
End If
If Not IsNull(TBis) And TBis >= 0 Then
If OSortierung = 1 Then
where1 = where1 + " AND TLieferungen.MGNR<=" + Format(TBis) + " "
Else
where1 = where1 + " AND TMitglieder.PLZ<=" + Format(TBis) + " "
End If
End If
query1 = SEL1 + where1 + GROUP1 + order1
savepath1 = InputBox("Excel Datei speichern unter:", "EXCEL DATEI EXPORTIEREN", "C:\Eigene Dateien\auszahlung.xls")
If IsNull(savepath) Or savepath1 = "" Then
Exit Sub
End If
DoCmd.Hourglass True
queryname1 = "AAuszahlungExport"
Dim db1 As Database
Set db1 = CurrentDb
On Error Resume Next
DoCmd.DeleteObject acQuery, queryname1
'MsgBox (query1)
db1.CreateQueryDef queryname1, query1
db1.Close
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel5, queryname1, savepath1, True
DoCmd.Hourglass False
End Sub
Private Sub BExport_Click()
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenForm "MExportAuszahlung"
End Sub
Private Sub BGebunden_Click()
Dim konst1
Dim minoechsle
konst1 = InputBox("Welchen Wert wollen Sie zu allen 'Gebunden'-Qualitätszuschlägen addieren ?")
If Not IsNull(konst1) And konst1 <> "" Then
Dim db1 As Database
Dim rs1 As Recordset
Set db1 = CurrentDb
minoechsle = DFirst("Von", "TQualitaetsstufen", "QSNR=3")
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND gebunden=true AND Oechsle>=" + Format(minoechsle))
While Not rs1.EOF
rs1.Edit
rs1!Betrag = rs1!Betrag + konst1
rs1.Update
rs1.MoveNext
Wend
rs1.Close
FUnter1.Requery
End If
End Sub
Private Sub BKonstant_Click()
Dim konst1
If Not IsNull(Forms!FAuszahlung!TSNR) Then
konst1 = InputBox("Auf welchen Wert wollen Sie alle Qualitätszuschläge der ausgewählten Sorte setzen ?")
If Not IsNull(konst1) And konst1 <> "" Then
Dim db1 As Database
Dim rs1 As Recordset
Set db1 = CurrentDb
If IsNull(TSANR) Then
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND Isnull(SANR)")
Else
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND SANR='" + TSANR + "'")
End If
While Not rs1.EOF
rs1.Edit
rs1!Betrag = konst1
rs1.Update
rs1.MoveNext
Wend
rs1.Close
FUnter1.Requery
End If
End If
End Sub
Private Sub BKopieren_Click()
If Not IsNull(Forms!FAuszahlung!TSNR) Then
DoCmd.OpenForm "FAuszahlungSortenAuswahl"
End If
End Sub
Private Sub BParameter_Click()
If Not IsNull(Forms!FAuszahlung!TSNR) Then
DoCmd.OpenForm "FAuszahlungParameter", acNormal
End If
End Sub
Private Sub BUngebundenGebunden_Click()
If MsgBox("Wollen Sie alle ungebundenen Sorten/Qualitätszuschläge auf die entsprechenden gebundenen Sorten/Qualitätszuschläge übertragen ?", vbYesNo) = vbYes Then
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND Gebunden=False")
While Not rs1.EOF
If IsNull(rs1("SANR")) Then
Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + rs1!SNR + "' And Oechsle=" + Format(rs1!Oechsle) + " AND Gebunden=True AND SANR=Null")
Else
Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + rs1!SNR + "' And Oechsle=" + Format(rs1!Oechsle) + " AND Gebunden=True AND SANR='" + Format(rs1!SANR) + "'")
End If
If Not rs2.EOF Then
rs2.Edit
rs2!Betrag = rs1!Betrag
rs2.Update
rs2.Close
End If
rs1.MoveNext
Wend
rs1.Close
FUnter1.Requery
End If
End Sub
Private Sub BVonVorigerTeilauszahlung_Click()
NummerierungVonVorigerAuszahlungFortsetzen
End Sub
Sub NummerierungVonVorigerAuszahlungFortsetzen()
BerechneErsteNummer
BerechneLetzteNummer
End Sub
Sub BerechneErsteNummer()
Dim maxNumber
'Erste Nummer bestimmen
maxNumber = DMax("TraubengutschriftNummerBis", "TAuszahlung", "Lesejahr=" + Format(TLesejahr) + " AND TraubengutschriftenNummerieren=True AND AZNR<>" + Format(TAZNR) + " AND TeilzahlungNr<" + Format(TZahlungNr))
If Not IsNull(maxNumber) Then
TTraubengutschriftNummerVon = maxNumber + 1
Else
TTraubengutschriftNummerVon = 1
End If
End Sub
Sub BerechneLetzteNummer()
Dim db1 As Database
Dim rs1 As Recordset
'Letzte Nummer bestimmen
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT DISTINCT TMitglieder.MGNR 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(Forms!FAuszahlung!TLesejahr))
rs1.MoveLast
TTraubengutschriftNummerBis = TTraubengutschriftNummerVon + rs1.recordcount - 1
rs1.Close
End Sub
Private Sub Form_Open(Cancel As Integer)
OSortierung = 1
TFusstext = GetParameter("AUSZAHLUNGTEXT")
'TZNR = 1
TGebunden = 0
If OTraubengutschriftenNummerieren Then
XNummernkreisRahmen.Visible = True
TTraubengutschriftNummerVon.Visible = True
TTraubengutschriftNummerBis.Visible = True
BVonVorigerTeilauszahlung.Visible = True
Else
XNummernkreisRahmen.Visible = False
TTraubengutschriftNummerVon.Visible = False
TTraubengutschriftNummerBis.Visible = False
BVonVorigerTeilauszahlung.Visible = False
End If
End Sub
Private Sub OTraubengutschriftenNummerieren_Click()
If OTraubengutschriftenNummerieren Then
XNummernkreisRahmen.Visible = True
TTraubengutschriftNummerVon.Visible = True
TTraubengutschriftNummerBis.Visible = True
BVonVorigerTeilauszahlung.Visible = True
Else
XNummernkreisRahmen.Visible = False
TTraubengutschriftNummerVon.Visible = False
TTraubengutschriftNummerBis.Visible = False
BVonVorigerTeilauszahlung.Visible = False
TTraubengutschriftNummerVon = ""
TTraubengutschriftNummerBis = ""
End If
End Sub
Private Sub TFusstext_Exit(Cancel As Integer)
If Not IsNull(TFusstext.Value) And TFusstext.Value <> "" Then
SetParameter "AUSZAHLUNGTEXT", TFusstext.Value
Else
SetParameter "AUSZAHLUNGTEXT", " "
End If
End Sub
Private Sub TGBZS_Exit(Cancel As Integer)
MsgBox ("Für gebundene und ungebundene Lieferungen gibt es auch unterschiedliche Sortentabellen pro Oechsle. Unterschiede zwischen gebundenen und ungebundenen Auszahlungen sollten daher in die Sortentabellen eingebracht werden. Das Feld 'Gebunden-Zuschlag' einer Auszahlung ist daher grundsätzlich obsolet, wird aber aus Kompatibilitätsgründen weiterhin bei der Berechnung berücksichtigt.")
End Sub
Private Sub TGebunden_Click()
FUnter1.Requery
End Sub
Private Sub TGebunden_Exit(Cancel As Integer)
FUnter1.Requery
End Sub
Private Sub TSANR_Click()
If Not IsNull(TSANR) Then
FUnter1.Form.RecordSource = "SELECT * FROM TAuszahlungSorten WHERE TAuszahlungSorten.SNR=[Forms]![FAuszahlung]![TSNR] AND TAuszahlungSorten.gebunden=[Forms]![FAuszahlung]![TGebunden] AND TAuszahlungSorten.SANR=[Forms]![FAuszahlung]![TSANR] ORDER BY TAuszahlungSorten.Oechsle"
Else
FUnter1.Form.RecordSource = "SELECT * FROM TAuszahlungSorten WHERE TAuszahlungSorten.SNR=[Forms]![FAuszahlung]![TSNR] AND TAuszahlungSorten.gebunden=[Forms]![FAuszahlung]![TGebunden] AND TAuszahlungSorten.SANR IS NULL ORDER BY TAuszahlungSorten.Oechsle"
End If
FUnter1.Requery
End Sub
Private Sub TSNR_Click()
FUnter1.Requery
End Sub
Private Sub TSNR_Exit(Cancel As Integer)
FUnter1.Requery
End Sub
Private Sub TTraubengutschriftNummerVon_Exit(Cancel As Integer)
BerechneLetzteNummer
End Sub
Private Sub TZahlungNr_Change()
Dim str1 As String
Dim str2 As String
Select Case Forms!FAuszahlung!TZahlungNr
Case 1:
If DSum("BTeilzahlung1", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 1.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Forms!FAuszahlung!TZahlungNr = 7
End If
End If
Case 2:
If DSum("BTeilzahlung2", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 2.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Forms!FAuszahlung!TZahlungNr = 7
End If
End If
Case 3:
If DSum("BTeilzahlung3", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 3.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Forms!FAuszahlung!TZahlungNr = 7
End If
End If
Case 4:
If DSum("BTeilzahlung4", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine 4.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Forms!FAuszahlung!TZahlungNr = 7
End If
End If
Case 5:
If DSum("BTeilzahlung5", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine frei definierbare Zahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Forms!FAuszahlung!TZahlungNr = 7
End If
End If
If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then
str1 = ""
Else
str1 = GetParameter("FREIERAUSZAHLUNGSTITEL")
str2 = ""
End If
While str2 = ""
str2 = InputBox("Bitte geben Sie den freien Auszahlungstitel ein:", "FREIER TITEL", str1)
Wend
SetParameter "FREIERAUSZAHLUNGSTITEL", str2
Case 6:
If DSum("BEndauszahlung", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then
If MsgBox("Es wurde für dieses Lesejahr bereits eine Endauszahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then
Forms!FAuszahlung!TZahlungNr = 7
End If
End If
End Select
End Sub
Private Sub TZahlungNr_Exit(Cancel As Integer)
If TZahlungNr.Value = 6 Then
OEndauszahlung = True
Else
OEndauszahlung = False
End If
End Sub
Private Sub Befehl283_Click()
Dim query As String
'DoCmd.OpenReport "BAuszahlungsvariante", acViewPreview
DoCmd.OpenQuery "AAuszahlungsvarianten"
DoCmd.Maximize
DoCmd.OpenReport "BAuszahlungsvarianteKopf", acViewPreview
End Sub
Sub ErgebnisfelderLoeschen()
TErgebnisBetrag = ""
TErgebnisGewicht = ""
TErgebnisGebunden = ""
TErgebnisDatensaetze = ""
End Sub
Function RundenAlt(Wert As Double, KommaStellen As Integer) As Double
Dim t1 As Double
t1 = CLng(Wert * 10 ^ KommaStellen) / 10 ^ KommaStellen
't1 = Round(Wert, KommaStellen)
RundenAlt = t1
End Function
Public Function Runden(value1 As Double, digits As Integer) As Double
Dim temp1 As Double
temp1 = value1 * (10 ^ digits)
If (temp1 * 10) Mod 10 = 5 Then
temp1 = temp1 + 1
temp1 = Fix(temp1)
temp1 = temp1 / (10 ^ digits)
Runden = temp1
Else
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
End If
End Function
Function GetAbschlägeAsString(LINR1 As Long) As String
Const separator = " / "
Const separator_length = 3
Dim db1 As Database
Dim rs1 As Recordset
Dim resultString As String
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT TAbschlaege.* FROM (TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR) INNER JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE TLieferungen.LINR=" + Format(LINR1))
resultString = ""
While Not rs1.EOF
resultString = resultString + separator + rs1!Bezeichnung
rs1.MoveNext
Wend
rs1.Close
If resultString <> "" Then resultString = Mid(resultString, 1 + separator_length)
GetAbschlägeAsString = resultString
End Function
View Git Blame Copy Permalink