Dim lastCNR Private Sub BAusPlanung_Click() Dim date1 date1 = InputBox("Geben Sie bitte das Datum ein, für welches Chargen erstellt werden sollen:", , Date) If IsDate(date1) Then ChargenErstellenAusPlanung (date1) RefreshAll End If End Sub Private Sub BBearbeiten_Click() If LChargen >= 0 Then lastCNR = LChargen DoCmd.OpenForm "FChargen", acNormal, , "CNR=" + Format(LChargen) End If End Sub Private Sub BBefuellungBeenden_Click() If LChargen >= 0 Then lastCNR = LChargen ChargeBefuellungBeenden (LChargen) RefreshAll End If End Sub Private Sub BBefuellungStarten_Click() If LChargen >= 0 Then lastCNR = LChargen ChargeBefuellungStarten (LChargen) RefreshAll End If End Sub Private Sub BDrucken_Click() DoCmd.OpenForm "MChargenListe" 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 BLoeschen_Click() If LChargen > 0 Then If DCount("LINR", "TLieferungen", "CNR=" + Format(LChargen)) > 0 Then MsgBox "Die ausgewählte Charge kann nicht gelöscht werden, da bereits Lieferungen zugeordnet sind!", vbCritical Exit Sub End If If DCount("CNR_Parent", "TChargenHierarchie", "CNR_Parent=" + Format(LChargen)) > 0 Then MsgBox "Die ausgewählte Charge kann nicht gelöscht werden, da aus dieser Charge andere Chargen erstellt worden sind!", vbCritical Exit Sub End If If MsgBox("Wollen Sie die ausgewählte Charge wirklich löschen?", vbYesNo) = vbYes Then Dim db1 As Database Set db1 = CurrentDb db1.Execute ("DELETE FROM TChargen WHERE CNR=" + Format(LChargen)) RefreshAll End If End If End Sub Private Sub BNeu_Click() Dim CNR1 As Long CNR1 = NeueCharge(TLesejahr) DoCmd.OpenForm "FChargen", acNormal, , "CNR=" + Format(CNR1) End Sub Private Sub BUmfuellen_Click() DoCmd.OpenForm "FChargeUmfuellen" 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 TSortierung = "BefuellungsBeginn,Chargennummer" lastCNR = -1 ODetailLieferungen = False RefreshAll End Sub Private Sub LChargen_DblClick(Cancel As Integer) lastCNR = LChargen DoCmd.OpenForm "FChargen", acNormal, , "CNR=" + Format(LChargen) End Sub Private Sub TBSNR_Change() RefreshAll End Sub Private Sub TBSNR_Click() RefreshAll End Sub Private Sub TCSNR_Change() RefreshAll End Sub Private Sub TLesejahr_Exit(Cancel As Integer) RefreshAll End Sub Function GetFilter() As String Dim filter1 filter1 = "Jahrgang=" + Format(TLesejahr) If Not IsNull(TZNR) Then filter1 = filter1 + " AND TChargen.ZNR=" + TZNR End If If Not IsNull(TCSNR) Then filter1 = filter1 + " AND TChargen.CSNR=" + TCSNR End If If Not IsNull(TBSNR) Then filter1 = filter1 + " AND TBehaelter.BSNR=" + TBSNR End If GetFilter = filter1 End Function Function GetOrder() As String If Not IsNull(TSortierung) Then GetOrder = " ORDER BY " + TSortierung Else GetOrder = "" End If End Function Sub RefreshAll() Dim filter1 Dim query1 'query1 = "SELECT TLieferungen.CNR, TLieferungen.Lieferscheinnummer AS Lieferscheinnr, TLieferungen.Datum, Format(TLieferungen.Uhrzeit,'HH:MM') as Zeit, TMitglieder.MGNR, [Nachname]+' '+IIf(IsNull([Vorname]),'',[Vorname]) AS Mitglied, TSorten.Bezeichnung AS Sorte, TLieferungen.Gewicht, TLieferungen.Oechsle, IIf(Storniert=True,'STORNIERT',Left(TLieferungen.Anmerkung,20)) AS Info FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR" query1 = "SELECT TChargen.CNR, TChargen.Chargennummer as ChNr, TChargen.Befuellungsbeginn as BefStart, TChargen.Befuellungsende as BefEnde, TChargen.BehaelterEntleertAm as Entleerg, TChargenStatus.ChargenStatus as Status, TChargen.SNR, TChargen.SANR, TQualitaetsstufen.Bezeichnung as Qualitaet, TChargen.Menge,TBehaelter.Kurzbezeichnung as Behaelter, TZweigstellen.Name as Zweigstelle FROM ((TZweigstellen RIGHT JOIN (TChargen LEFT JOIN TChargenStatus ON TChargen.CSNR = TChargenStatus.CSNR) ON TZweigstellen.ZNR = TChargen.ZNR) LEFT JOIN TBehaelter ON TChargen.BNR = TBehaelter.BNR) LEFT JOIN TQualitaetsstufen ON TChargen.QSNRVon = TQualitaetsstufen.QSNR" filter1 = GetFilter query1 = query1 + " WHERE " + filter1 + GetOrder 'MsgBox (query1) LChargen.RowSource = query1 LChargen.Requery LChargen.SetFocus If lastCNR = -1 And LChargen.ListCount > 0 Then 'MsgBox (LChargen.ItemData(1)) LChargen = LChargen.ItemData(1) End If If lastCNR >= 0 Then LChargen = lastCNR End If End Sub Private Sub TSortierung_Change() RefreshAll End Sub Private Sub TZNR_Change() RefreshAll End Sub Private Sub Befehl88_Click() On Error GoTo Err_Befehl88_Click DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 DoCmd.PrintOut acSelection Exit_Befehl88_Click: Exit Sub Err_Befehl88_Click: MsgBox Err.Description Resume Exit_Befehl88_Click End Sub