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