Move wgmaster/vba/Form_* to wgmaster/vba/form/*
This commit is contained in:
515
wgmaster/vba/form/Form_MAuszahlungAuswahl.frm
Normal file
515
wgmaster/vba/form/Form_MAuszahlungAuswahl.frm
Normal file
@ -0,0 +1,515 @@
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user