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