Exported VBA
This commit is contained in:
342
wgmaster/vba/Form_MLeseauswertung.frm
Normal file
342
wgmaster/vba/Form_MLeseauswertung.frm
Normal file
@ -0,0 +1,342 @@
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user