343 lines
10 KiB
Plaintext
343 lines
10 KiB
Plaintext
|
|
Private Sub Babbrechen_Click()
|
|
|
|
DoCmd.Close
|
|
|
|
End Sub
|
|
|
|
Private Sub BOk_Click()
|
|
|
|
Dim filter1 As String
|
|
|
|
filter1 = GetFilter(False)
|
|
|
|
Select Case OListe
|
|
|
|
Case 1:
|
|
DoCmd.OpenReport "BLieferjournal", acPreview, , filter1
|
|
Case 2:
|
|
DoCmd.OpenReport "BSortenstatistik", acPreview, , filter1
|
|
Case 3:
|
|
DoCmd.OpenReport "BSortenstatistikAttribute", acPreview, , filter1
|
|
Case 4:
|
|
DoCmd.OpenReport "BQualitätsstatistik", acPreview, , filter1
|
|
Case 5:
|
|
DoCmd.OpenReport "BQualitätsstatistikRotWeiss", acPreview, , filter1
|
|
Case 6:
|
|
DoCmd.OpenReport "BLieferstatistikProOrt", acPreview, , filter1
|
|
|
|
End Select
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub BTagWeiter_Click()
|
|
|
|
TVon = TVon + 1
|
|
TBis = TBis + 1
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub BTagZurueck_Click()
|
|
|
|
TVon = TVon - 1
|
|
TBis = TBis - 1
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Open(Cancel As Integer)
|
|
|
|
OListe = 1
|
|
TVon = Date
|
|
TBis = Date
|
|
'TZNR = DFirst("ZNR", "TZweigstellen")
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub OListe_Click()
|
|
|
|
RefreshAll
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub TBis_Exit(Cancel As Integer)
|
|
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub TFilter_Click()
|
|
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub TFilter_Exit(Cancel As Integer)
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub TFilterIn_Click()
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub TFilterIn_Exit(Cancel As Integer)
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub TVon_Exit(Cancel As Integer)
|
|
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
|
|
Function GetFilter(optionFullMGNR As Boolean)
|
|
|
|
Dim filter1 As String
|
|
Dim hk As String
|
|
|
|
If IsNull(TZNR) Then
|
|
filter1 = ""
|
|
Else
|
|
filter1 = "TLieferungen.ZNR=" + Format(Forms!MLeseauswertung!TZNR) + " AND "
|
|
End If
|
|
|
|
filter1 = filter1 + "[Datum]>=Datevalue('" + Format([TVon], "dd.mm.yyyy") + "') AND [Datum]<=Datevalue('" + Format([TBis], "dd.mm.yyyy") + "')"
|
|
'MsgBox (filter1)
|
|
|
|
filter1 = filter1 + BuildMGNRIn(optionFullMGNR)
|
|
'On Error GoTo error
|
|
'If Not IsNull(TFilter) And TFilter <> "" Then
|
|
' If TFilterIn = "MGNR" Then
|
|
' hk = ""
|
|
' If CLng(TFilter) <= 0 Then TFilter = ""
|
|
' Else
|
|
' hk = "'"
|
|
' End If
|
|
' filter1 = filter1 + " AND " + TFilterIn + "=" + hk + Format(TFilter) + hk
|
|
'End If
|
|
|
|
'error:
|
|
GetFilter = filter1
|
|
|
|
|
|
End Function
|
|
|
|
Sub RefreshAll()
|
|
|
|
|
|
Dim where2, where3
|
|
|
|
|
|
'If TZNR.ListIndex >= 0 Then
|
|
'where2 = " AND [TLieferungen].[ZNR]=[Formulare]![MLeseauswertung].[TZNR] "
|
|
'Else
|
|
'where2 = ""
|
|
'End If
|
|
|
|
Select Case OListe
|
|
|
|
Case 1: ' alle lieferungen
|
|
where2 = GetFilter(True)
|
|
LLieferungen.RowSource = "SELECT TLieferungen.Lieferscheinnummer AS Lieferscheinnr, TLieferungen.MGNR, IIf(IsNull([Nachname]),'',[Nachname])+' '+IIf(IsNull([Vorname]),'',[Vorname]) AS Name, UCase([SNR]) AS Sorte, Oechsle, Gewicht FROM TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR WHERE " + where2 + " ORDER BY TLieferungen.LINR;"
|
|
LLieferungen.ColumnCount = 6
|
|
LLieferungen.ColumnWidths = "3cm;1 cm;5,2 cm;1cm;1,5cm;1,5cm"
|
|
BOk.Visible = True
|
|
|
|
Case 2: ' sorten zusammen
|
|
where2 = GetFilter(False)
|
|
LLieferungen.RowSource = "SELECT TSorten.Bezeichnung AS Sorte, Format(Sum([Gewicht]*[Oechsle])/Sum([Gewicht]),'0,0') AS Oechsle1, Format(Sum(TLieferungen.Gewicht),'#######') AS Gewicht1 FROM TSorten INNER JOIN TLieferungen ON TSorten.SNR = TLieferungen.SNR WHERE " + where2 + " GROUP BY TSorten.typ,TSorten.Bezeichnung ORDER By TSorten.typ, TSorten.Bezeichnung"
|
|
'LLieferungen.RowSource = "SELECT TSorten.Bezeichnung AS Sorte, Format(Sum([Gewicht]*[Oechsle])/Sum([Gewicht]),'0,0') AS Oechsle1, Format(Sum(TLieferungen.Gewicht),'#######') AS Gewicht1 FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE " + where2 + " GROUP BY TSorten.Bezeichnung;"
|
|
LLieferungen.ColumnCount = 3
|
|
LLieferungen.ColumnWidths = "9cm;1,5cm;1,5cm"
|
|
BOk.Visible = True
|
|
|
|
Case 3: ' sorten&attribute zusammen
|
|
where2 = GetFilter(False)
|
|
|
|
LLieferungen.RowSource = "SELECT TSorten.Bezeichnung AS Sorte, TSortenAttribute.Attribut, Format(Sum([Gewicht]*[Oechsle])/Sum([Gewicht]),'#,#00') AS Oechsle1, Format(Sum(TLieferungen.Gewicht),'#') AS Gewicht1 FROM (TSorten INNER JOIN TLieferungen ON TSorten.SNR = TLieferungen.SNR) LEFT JOIN TSortenAttribute ON TLieferungen.SANR = TSortenAttribute.SANR WHERE (((" + where2 + ") <> False)) GROUP BY TSorten.typ,TSorten.Bezeichnung, TSortenAttribute.Attribut ORDER By TSorten.typ, TSorten.Bezeichnung,TSortenAttribute.Attribut"
|
|
'LLieferungen.RowSource = "SELECT TSorten.Bezeichnung AS Sorte, Format(Sum([Gewicht]*[Oechsle])/Sum([Gewicht]),'0,0') AS Oechsle1, Format(Sum(TLieferungen.Gewicht),'#######') AS Gewicht1 FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE " + where2 + " GROUP BY TSorten.Bezeichnung;"
|
|
LLieferungen.ColumnCount = 4
|
|
LLieferungen.ColumnWidths = "7cm;2cm;1,5cm;1,5cm"
|
|
BOk.Visible = True
|
|
|
|
Case 4: ' qualitäten zusammen
|
|
where2 = GetFilter(False)
|
|
LLieferungen.RowSource = "SELECT TQualitaetsstufen.Bezeichnung, Format(Sum([Gewicht]*[Oechsle])/Sum(Gewicht),'#,#00') AS Oechsle1, Sum(TLieferungen.Gewicht) AS Gewicht1, TLieferungen.QSNR FROM (TSorten INNER JOIN TLieferungen ON TSorten.SNR = TLieferungen.SNR) INNER JOIN TQualitaetsstufen ON TLieferungen.QSNR = TQualitaetsstufen.QSNR WHERE " + where2 + " GROUP BY TQualitaetsstufen.Bezeichnung, TLieferungen.QSNR ORDER BY TLieferungen.QSNR;"
|
|
'LLieferungen.RowSource = "SELECT TQualitaetsstufen.Bezeichnung, Format(Sum([Gewicht]*[Oechsle])/Sum(Gewicht),'#,#00') AS Oechsle1, Sum(TLieferungen.Gewicht) AS Gewicht1, TLieferungen.QSNR FROM (TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR) INNER JOIN TQualitaetsstufen ON TLieferungen.QSNR = TQualitaetsstufen.QSNR WHERE " + where2 + " GROUP BY TQualitaetsstufen.Bezeichnung, TLieferungen.QSNR ORDER BY TLieferungen.QSNR;"
|
|
LLieferungen.ColumnCount = 3
|
|
LLieferungen.ColumnWidths = "9cm;1,5 cm;1,5"
|
|
BOk.Visible = True
|
|
|
|
Case 5: ' qualitäten zusammen, rot/weiß
|
|
where2 = GetFilter(False)
|
|
LLieferungen.RowSource = "SELECT TSorten.Typ, TQualitaetsstufen.Bezeichnung, Format(Sum([Gewicht]*[Oechsle])/Sum(Gewicht),'#,#00') AS Oechsle1, Sum(TLieferungen.Gewicht) AS Gewicht1, TLieferungen.QSNR FROM (TSorten INNER JOIN TLieferungen ON TSorten.SNR = TLieferungen.SNR) INNER JOIN TQualitaetsstufen ON TLieferungen.QSNR = TQualitaetsstufen.QSNR WHERE " + where2 + " GROUP BY TQualitaetsstufen.Bezeichnung, TSorten.Typ, TLieferungen.QSNR ORDER BY TSorten.Typ, TLieferungen.QSNR"
|
|
LLieferungen.ColumnCount = 4
|
|
LLieferungen.ColumnWidths = "3 cm;6 cm;1,5 cm;1,5"
|
|
BOk.Visible = True
|
|
|
|
Case 6: ' lieferstatistik pro ort
|
|
where2 = GetFilter(False)
|
|
|
|
'"SELECT TMitglieder.Ort, Sum(TLieferungen.Gewicht) AS SummeGewicht FROM TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR WHERE " + where2 + " GROUP BY TMitglieder.Ort ORDER BY TMitglieder.Ort"
|
|
|
|
|
|
LLieferungen.RowSource = "SELECT TMitglieder.Ort, Sum(TLieferungen.Gewicht) AS SummeGewicht, Format(Avg(TLieferungen.Oechsle),'0.0') AS MittelwertOechsle FROM TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR WHERE " + where2 + " GROUP BY TMitglieder.Ort ORDER BY TMitglieder.Ort"
|
|
LLieferungen.ColumnCount = 3
|
|
LLieferungen.ColumnWidths = "4 cm;2 cm; 3 cm"
|
|
BOk.Visible = True
|
|
|
|
|
|
|
|
End Select
|
|
|
|
'CalculateSums (where2)
|
|
TGesamtgewicht.Requery
|
|
TQualitaet.Requery
|
|
LLieferungen.Requery
|
|
|
|
RefreshBeschreibung
|
|
|
|
End Sub
|
|
|
|
|
|
Sub RefreshBeschreibung()
|
|
|
|
Dim Beschreibung As String
|
|
|
|
|
|
If Not IsNull(TVon) And Not IsNull(TBis) Then
|
|
If TVon = TBis Then
|
|
Beschreibung = Beschreibung + Format(TVon, "dd.mm.yyyy") + ", "
|
|
Else
|
|
Beschreibung = Beschreibung + Format(TVon, "dd.mm.yyyy") + "-" + Format(TBis, "dd.mm.yyyy") + ", "
|
|
End If
|
|
Else
|
|
If Not IsNull(TVon) Then
|
|
Beschreibung = Beschreibung + "ab " + Format(TVon, "dd.mm.yyyy") + ", "
|
|
End If
|
|
If Not IsNull(TBis) Then
|
|
Beschreibung = Beschreibung + "bis " + Format(TBis, "dd.mm.yyyy") + ", "
|
|
End If
|
|
|
|
End If
|
|
|
|
If Not IsNull(TZNR) Then
|
|
Beschreibung = Beschreibung + "Zweigstelle=" + DFirst("Name", "TZweigstellen", "ZNR=" + Format(TZNR)) + ", "
|
|
End If
|
|
|
|
If Not IsNull(TFilter) And Not IsNull(TFilterIn) Then
|
|
Beschreibung = Beschreibung + TFilterIn + "=" + TFilter + ", "
|
|
End If
|
|
|
|
Beschreibung = Left(Beschreibung, Len(Beschreibung) - 2)
|
|
|
|
TBeschreibung = Beschreibung
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub TZNR_Click()
|
|
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Private Sub TZNR_Exit(Cancel As Integer)
|
|
|
|
RefreshAll
|
|
|
|
End Sub
|
|
|
|
Sub CalculateSums(where1 As String)
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim gesamtgewicht As Double
|
|
Dim qualitaet As Double
|
|
|
|
Set db1 = CurrentDb
|
|
If where1 <> "" Then where1 = " WHERE " + where1
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR " + where1)
|
|
While Not rs1.EOF
|
|
If Not IsNull(rs1!Gewicht) Then
|
|
gesamtgewicht = gesamtgewicht + rs1!Gewicht
|
|
If Not IsNull(rs1!Oechsle) Then
|
|
qualitaet = qualitaet + rs1!Gewicht * rs1!Oechsle
|
|
End If
|
|
End If
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
|
|
TGesamtgewicht = gesamtgewicht
|
|
If gesamtgewicht > 0 Then
|
|
TQualitaet = Runden(qualitaet / gesamtgewicht, 1)
|
|
Else
|
|
TQualitaet = ""
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Function BuildMGNRIn(optionFullMGNR As Boolean) As String
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim mgnrinstr As String
|
|
Dim filter2 As String
|
|
|
|
Set db1 = CurrentDb
|
|
|
|
mgnrinstr = ""
|
|
On Error GoTo endbuild
|
|
If Not IsNull(TFilter) And TFilter <> "" Then
|
|
|
|
If TFilterIn = "MGNR" Then
|
|
If CLng(TFilter) > 0 Then
|
|
mgnrinstr = " AND MGNR = " + Format(TFilter)
|
|
If optionFullMGNR Then
|
|
mgnrinstr = " AND TLieferungen.MGNR = " + Format(TFilter)
|
|
Else
|
|
mgnrinstr = " AND MGNR = " + Format(TFilter)
|
|
End If
|
|
GoTo endbuild
|
|
End If
|
|
End If
|
|
filter2 = " WHERE " + TFilterIn + "='" + Format(TFilter) + "'"
|
|
|
|
|
|
Set rs1 = db1.OpenRecordset("SELECT DISTINCT TMitglieder.MGNR FROM TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR " + filter2 + " ORDER BY TMitglieder.MGNR")
|
|
If optionFullMGNR Then
|
|
mgnrinstr = " AND TLieferungen.MGNR IN (-1,"
|
|
Else
|
|
mgnrinstr = " AND MGNR IN (-1,"
|
|
End If
|
|
While Not rs1.EOF
|
|
mgnrinstr = mgnrinstr + Format(rs1!MGNR) + ","
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
mgnrinstr = Left(mgnrinstr, Len(mgnrinstr) - 1) + ") "
|
|
|
|
End If
|
|
|
|
endbuild:
|
|
'MsgBox (mgnrinstr)
|
|
BuildMGNRIn = mgnrinstr
|
|
|
|
End Function
|