516 lines
12 KiB
Plaintext
516 lines
12 KiB
Plaintext
|
|
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
|