Dim lastAZNR

Private Sub BBearbeiten_Click()

If LAuszahlungen >= 0 Then
 lastAZNR = LAuszahlungen
 DoCmd.OpenForm "FAuszahlung", acNormal, , "AZNR=" + Format(LAuszahlungen)
End If

End Sub


Private Sub BJahrWeiter_Click()

If Not IsNull(TLesejahr) Then
 TLesejahr = TLesejahr + 1
 RefreshAll
End If

End Sub

Private Sub BJahrZurueck_Click()

If Not IsNull(TLesejahr) Then
 TLesejahr = TLesejahr - 1
 RefreshAll
End If

End Sub

Private Sub BKopieren_Click()

Dim aznr2 As Long

If Not IsNull(LAuszahlungen) And LAuszahlungen > 0 Then
 If MsgBox("Wollen Sie diese Variante für eine neue Variante kopieren ?", vbYesNo) = vbYes Then
   aznr2 = NeueAuszahlung
   AuszahlungKopieren LAuszahlungen, aznr2
   lastAZNR = aznr2
   RefreshAll
 End If
Else
 MsgBox ("Bitte wählen sie die zu kopierende Auszahlung !")
End If

End Sub


Private Sub BLöschen_Click()

Dim aznr2

If Not IsNull(LAuszahlungen) And LAuszahlungen > 0 Then
 If MsgBox("Wollen Sie diese Auszahlung wirklich löschen ?", vbYesNo) = vbYes Then
  AuszahlungLöschen (LAuszahlungen)
 End If
Else
 MsgBox ("Bitte wählen sie die zu löschende Auszahlung !")
End If
RefreshAll

End Sub

Private Sub BNeu_Click()

Dim aznr1 As Long

aznr1 = NeueAuszahlung
lastAZNR = aznr1
RefreshAll

End Sub

Private Sub Form_Activate()

RefreshAll

End Sub

Private Sub Form_Load()
 

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

TZahlung = 0

lastAZNR = -1

RefreshAll



End Sub

Private Sub LAuszahlungen_DblClick(Cancel As Integer)

lastAZNR = LAuszahlungen

DoCmd.OpenForm "FAuszahlung", acNormal, , "AZNR=" + Format(LAuszahlungen)


End Sub

Private Sub TLesejahr_Exit(Cancel As Integer)

RefreshAll

End Sub

Function GetFilter() As String

Dim filter1

filter1 = " Lesejahr =" + Format(TLesejahr)

If Not IsNull(TZahlung) And TZahlung > 0 Then
  filter1 = filter1 + " AND TeilzahlungNr =" + TZahlung
End If

GetFilter = filter1

End Function


Sub RefreshAll()

Dim filter1
Dim query1

query1 = "SELECT TAuszahlung.AZNR, TAuszahlung.Lesejahr, IIf([TeilzahlungNr]=7,'Probevariante',IIf([TeilzahlungNr]=6,'Endauszahlung',IIf([TeilzahlungNr]=5,Getparameter('FREIERAUSZAHLUNGSTITEL'),Format([TeilzahlungNr])+' .Teilzahlung'))) AS Zahlung, TAuszahlung.Titel, TAuszahlung.Beschreibung, TAuszahlung.Datum FROM TAuszahlung "

filter1 = GetFilter
query1 = query1 + " WHERE " + filter1 + GetOrder
'MsgBox (query1)
LAuszahlungen.RowSource = query1
LAuszahlungen.Requery

LAuszahlungen.SetFocus

If lastAZNR = -1 And LAuszahlungen.ListCount > 0 Then
'MsgBox (LAuszahlungen.ItemData(1))
 LAuszahlungen = LAuszahlungen.ItemData(1)
End If

If lastAZNR >= 0 Then
 LAuszahlungen = lastAZNR
End If


End Sub



Private Sub TZahlung_Change()

RefreshAll

End Sub


Function NeueAuszahlung() As Long

Dim str1 As String
Dim db1 As Database
Dim rs1 As Recordset
Dim SNR(0 To 255) As String
Dim SANR(0 To 255) As String
Dim Oechsle(0 To 255) As Long
Dim sortencount As Integer, oechslecount As Integer, i, j
Dim aznr1 As Long
 
'Requery
NeueAuszahlung = 0
'DoCmd.GoToRecord , , acLast
'ErgebnisfelderLoeschen

str1 = InputBox("Geben Sie bitte einen Titel für die neue Variante ein: ")
lj = InputBox("Geben Sie bitte das Lesejahr ein: ", , TLesejahr)

If str1 <> "" And Not IsNull(str1) And Not IsNull(lj) Then

 DoCmd.Hourglass True
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("TAuszahlung")
 rs1.AddNew
 rs1!Titel = str1
 rs1!TeilzahlungNr = 7
 rs1!Lesejahr = CLng(lj)
 rs1!Datum = Date
 rs1!Rebelzuschlag = 0
 rs1!Grundbetrag = 0
 rs1!GBZS = 0
 rs1!Ausgabefaktor = 1
 aznr1 = rs1!AZNR
 rs1.Update
 rs1.Close

 'TTitel = str1
 'TLesejahr = lj
 
 Dim omin, omax
 
 omin = DMin("Oechsle", "TLieferungen", "Year(Datum)=" + Format(lj) + " AND Oechsle>0")
 omax = DMax("Oechsle", "TLieferungen", "Year(Datum)=" + Format(lj) + " AND Oechsle<150")
 
 'DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

 Set db1 = CurrentDb
 
 ' Sortenkürzel sicherheitshalber nochmals bereinigen
 Set rs1 = db1.OpenRecordset("SELECT SNR FROM TLieferungen WHERE Year(Datum)=" + Format(lj))
 While Not rs1.EOF
  If IsNull(rs1!SNR) Or rs1!SNR = "" Then
  Else
   If UCase(rs1("SNR")) <> rs1("SNR") Then
    rs1.Edit
    rs1("SNR") = UCase(rs1("SNR"))
    rs1.Update
   End If
  End If
  rs1.MoveNext
 Wend
 rs1.Close
 
 
 ' Sorten einlesen
 sortencount = 0
 
 Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNR FROM TLieferungen WHERE Year(Datum)=" + Format(lj) + " ORDER BY SNR")
'Set rs1 = db1.OpenRecordset("SELECT * FROM TSorten")
 
 While Not rs1.EOF
  If IsNull(rs1!SNR) Or rs1!SNR = "" Then
  Else
   SNR(sortencount) = rs1!SNR
   SANR(sortencount) = ""
   sortencount = sortencount + 1
  End If
  rs1.MoveNext
 Wend
 rs1.Close

' Oechsle einlesen
 If omin > Val(GetParameter("ABWERTUNGOECHSLE")) Then
   omin = GetParameter("ABWERTUNGOECHSLE")
 End If
 oechslecount = 0
 For i = omin - 5 To omax + 5
  Oechsle(oechslecount) = i
  oechslecount = oechslecount + 1
 Next i
 
 
 Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten")
 For i = 0 To sortencount - 1
  For j = 0 To oechslecount - 1
   rs1.AddNew
   rs1!AZNR = aznr1
   rs1!Oechsle = Oechsle(j)
   rs1!SNR = SNR(i)
   rs1!Betrag = 0
   rs1!gebunden = False
   rs1.Update
   rs1.AddNew
   rs1!AZNR = aznr1
   rs1!Oechsle = Oechsle(j)
   rs1!SNR = SNR(i)
   rs1!Betrag = 0
   rs1!gebunden = True
   rs1.Update
  Next j, i
 rs1.Close
 
 'Create Qualitätsstufentable for QSNR=0 / "Wein" only
 Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSortenQualitätsstufe")
 For i = 0 To sortencount - 1
   rs1.AddNew
   rs1!AZNR = aznr1
   rs1!SNR = SNR(i)
   rs1!SANR = SANR(i)
   rs1!QSNR = 0
   rs1!Betrag = 0
   rs1.Update
   
  Next i
 rs1.Close
 
 'Erweiterung der Liste um vorhandene Sortenattribute
 ' Sorten einlesen
 sortencount = 0
 Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNR,SANR FROM TLieferungen WHERE Year(Datum)=" + Format(lj) + " AND SANR<>NULL AND SANR<>''")
 While Not rs1.EOF
  If IsNull(rs1!SNR) Or rs1!SNR = "" Then
  Else
   SNR(sortencount) = rs1!SNR
   SANR(sortencount) = rs1!SANR
   sortencount = sortencount + 1
  End If
  rs1.MoveNext
 Wend
 rs1.Close
 
 Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten")
 For i = 0 To sortencount - 1
  For j = 0 To oechslecount - 1
   rs1.AddNew
   rs1!AZNR = aznr1
   rs1!Oechsle = Oechsle(j)
   rs1!SNR = SNR(i)
   rs1!SANR = SANR(i)
   rs1!Betrag = 0
   rs1!gebunden = False
   rs1.Update
   rs1.AddNew
   rs1!AZNR = aznr1
   rs1!Oechsle = Oechsle(j)
   rs1!SNR = SNR(i)
   rs1!SANR = SANR(i)
   rs1!Betrag = 0
   rs1!gebunden = True
   rs1.Update
  Next j, i
 rs1.Close
 
 'Create Qualitätsstufentable for QSNR=0 / "Wein" only
 Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSortenQualitätsstufe")
 For i = 0 To sortencount - 1
   rs1.AddNew
   rs1!AZNR = aznr1
   rs1!SNR = SNR(i)
   rs1!SANR = SANR(i)
   rs1!QSNR = 0
   rs1!Betrag = 0
   rs1.Update
   
  Next i
 rs1.Close
 
 
 'FUnter1.Requery
 DoCmd.Hourglass False
 NeueAuszahlung = aznr1
End If


End Function


Function AuszahlungKopierenAlt(aznr1 As Long) As Long

Dim aznr2 As Long
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim str1 As String
Dim lj As String
Dim Lesejahr1 As Long

 
 str1 = InputBox("Geben Sie bitte einen Titel für die neue Variante ein: ")
  
 If str1 <> "" And Not IsNull(str1) Then
    
    Lesejahr1 = InputBox("Lesejahr: ", "Lesejahr", TLesejahr)
 
    Set db1 = CurrentDb
    Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(aznr1))
    Set rs4 = db1.OpenRecordset("SELECT * FROM TAuszahlung WHERE AZNR=" + Format(aznr1))
    Set rs2 = db1.OpenRecordset("TAuszahlungSorten")
    Set rs3 = db1.OpenRecordset("TAuszahlung")
    rs3.AddNew
    rs3!Titel = str1
    rs3!Lesejahr = Lesejahr1
    rs3!Datum = rs4!Datum
    rs3!Grundbetrag = rs4!Grundbetrag
    rs3!GBZS = rs4!GBZS
    rs3!Ausgabefaktor = 1
    rs3!TeilzahlungNr = 7
    rs3!Endauszahlung = 0
    rs3!RIZS = rs4!RIZS
    rs3!GEZS = rs4!GEZS
    rs3!GLZS = rs4!GLZS
    rs3!WEZS = rs4!WEZS
    rs3!REZS = rs4!REZS
    rs3!Abschlägeberücksichtigen = rs4!Abschlägeberücksichtigen
    rs3!GebundenBerücksichtigen = rs4!GebundenBerücksichtigen
    rs3!AufschlagVolllieferanten = rs4!AufschlagVolllieferanten
    rs3.Update
    rs3.Close
    aznr2 = DMax("AZNR", "TAuszahlung")
    
    While Not rs1.EOF
     rs2.AddNew
     rs2!SNR = rs1!SNR
     rs2!Oechsle = rs1!Oechsle
     rs2!Betrag = rs1!Betrag
     rs2!AZNR = aznr2
     rs2.Update
     rs1.MoveNext
    Wend
    rs1.Close
    rs2.Close
    


    'Requery
    'DoCmd.GoToRecord , , acLast
    AuszahlungKopierenAlt = aznr2
 
 End If



End Function


Sub AuszahlungKopieren(from_aznr As Long, to_aznr As Long)
' Kopiert die Grundwerte und Sortentabellen soweit vorhanden

Dim aznr2 As Long
Dim db1 As Database
Dim rs_from As Recordset
Dim rs_from_sorten As Recordset
Dim rs_to As Recordset
Dim rs_to_sorten As Recordset
Dim KeineGebundenen As Boolean
Dim GBZS1 As Double

Dim SNR1 As Double
Dim Oechlse1 As Double
Dim Betrag1 As Double

Set db1 = CurrentDb
Set rs_to = db1.OpenRecordset("SELECT * FROM TAuszahlung WHERE AZNR=" + Format(to_aznr))
Set rs_from = db1.OpenRecordset("SELECT * FROM TAuszahlung WHERE AZNR=" + Format(from_aznr))

rs_to.Edit
rs_to!Grundbetrag = rs_from!Grundbetrag
rs_to!GBZS = rs_from!GBZS
GBZS1 = rs_from!GBZS
rs_to!Ausgabefaktor = rs_from!Ausgabefaktor
rs_to!TeilzahlungNr = 7
rs_to!Endauszahlung = 0
rs_to!RIZS = rs_from!RIZS
rs_to!GEZS = rs_from!GEZS
rs_to!GLZS = rs_from!GLZS
rs_to!WEZS = rs_from!WEZS
rs_to!REZS = rs_from!REZS
rs_to!Abschlägeberücksichtigen = rs_from!Abschlägeberücksichtigen
rs_to!GebundenBerücksichtigen = rs_from!GebundenBerücksichtigen
rs_to!AufschlagVolllieferanten = rs_from!AufschlagVolllieferanten
rs_to.Update
rs_to.Close
rs_from.Close

'enthält Kopie Felder mit Gebunden ?
If DCount("SNR", "TAuszahlungSorten", "AZNR=" + Format(from_aznr) + " AND gebunden=True") > 0 Then
 KeineGebundenen = False
Else
 KeineGebundenen = True
End If


'Sortentabelleninhalte kopieren soweit verfügbar
Set rs_from_sorten = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(from_aznr))

While Not rs_from_sorten.EOF

  If IsNull(rs_from_sorten!SANR) Then
    Set rs_to_sorten = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(to_aznr) + " AND SNR='" + rs_from_sorten!SNR + "' AND Oechsle=" + Format(rs_from_sorten!Oechsle) + " AND gebunden=" + IIf(rs_from_sorten!gebunden, "true", "false") + " AND SANR=Null")
  Else
    Set rs_to_sorten = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(to_aznr) + " AND SNR='" + rs_from_sorten!SNR + "' AND Oechsle=" + Format(rs_from_sorten!Oechsle) + " AND gebunden=" + IIf(rs_from_sorten!gebunden, "true", "false") + " AND SANR='" + Format(rs_from_sorten!SANR) + "'")
  End If

    If Not rs_to_sorten.EOF Then
     rs_to_sorten.Edit
     rs_to_sorten!Betrag = rs_from_sorten!Betrag
     rs_to_sorten.Update
     rs_to_sorten.Close
    End If
    
    If KeineGebundenen = True Then
     Set rs_to_sorten = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(to_aznr) + " AND SNR='" + rs_from_sorten!SNR + "' AND Oechsle=" + Format(rs_from_sorten!Oechsle) + " AND gebunden=True")
     If Not rs_to_sorten.EOF Then
      rs_to_sorten.Edit
      rs_to_sorten!Betrag = rs_from_sorten!Betrag '+ GBZS1
      rs_to_sorten!gebunden = True
      rs_to_sorten.Update
      rs_to_sorten.Close
     End If
    End If

 rs_from_sorten.MoveNext
Wend

End Sub



Sub AuszahlungLöschen(aznr1 As Long)

Dim db1 As Database

    Set db1 = CurrentDb
    db1.Execute ("DELETE * FROM TAuszahlungSorten WHERE AZNR=" + Format(aznr1))
    db1.Execute ("DELETE * FROM TAuszahlung WHERE AZNR=" + Format(aznr1))

End Sub