From 9de4f26ded108741d2f15c64c5f594a75e26b702 Mon Sep 17 00:00:00 2001 From: Lorenz Stechauner Date: Sat, 25 Nov 2023 18:44:52 +0100 Subject: [PATCH] wgmaster: Move vba/ to wgmaster repository --- wgmaster/vba/MAuszahlung.bas | 522 ------ wgmaster/vba/MChargen.bas | 613 ------- wgmaster/vba/MFlaechenbindungen.bas | 89 - wgmaster/vba/MMigration.bas | 45 - wgmaster/vba/MMisc.bas | 501 ------ wgmaster/vba/MProperties.bas | 398 ----- wgmaster/vba/MTanksanlegen.bas | 407 ----- wgmaster/vba/MTcpSocket.bas | 215 --- wgmaster/vba/MWaage.bas | 995 ----------- wgmaster/vba/Report_BAuszahlung.frm | 29 - wgmaster/vba/Report_BAuszahlungMGNR.frm | 27 - wgmaster/vba/Report_BBuchungsliste.frm | 28 - wgmaster/vba/Report_BUeberweisungsliste.frm | 27 - .../vba/Report_Mitglieder-Information.frm | 27 - wgmaster/vba/empty/Form_FBehaelter.frm | 5 - .../vba/empty/Form_FChargenBehandlungen.frm | 5 - .../empty/Form_FGrosslagenGebieteSorten.frm | 4 - wgmaster/vba/empty/Form_FMitgliedInfo.frm | 10 - wgmaster/vba/empty/Form_FSortenAttribute.frm | 7 - .../empty/Form_FSortenAttributeEingabe.frm | 1 - wgmaster/vba/empty/Form_FZweigstellen.frm | 3 - wgmaster/vba/empty/Report_BAbschlaege.frm | 10 - wgmaster/vba/empty/Report_BAbwertungen.frm | 10 - .../vba/empty/Report_BAbwertungenMGNR.frm | 10 - .../vba/empty/Report_BAbwertungenSorte.frm | 10 - ...rt_BAnlieferungenJahresvergleichDetail.frm | 10 - .../Report_BAnlieferungsbestaetigung.frm | 10 - .../Report_BAnlieferungsbestaetigungMGNR.frm | 10 - .../empty/Report_BAuszahlungsvarianteKopf.frm | 10 - .../Report_BAuszahlungsvarianteSorten.frm | 10 - ...rt_BAuszahlungsvarianteSortenattribute.frm | 10 - wgmaster/vba/empty/Report_BBanken.frm | 10 - wgmaster/vba/empty/Report_BBehaelter.frm | 10 - .../empty/Report_BBewirtschaftungsarten.frm | 10 - .../vba/empty/Report_BBuchungslisteBrutto.frm | 10 - wgmaster/vba/empty/Report_BChargenListe.frm | 10 - .../vba/empty/Report_BChargenStammblatt.frm | 10 - .../Report_BChargenStammblattBehandlungen.frm | 10 - .../Report_BChargenStammblattLieferungen.frm | 10 - .../vba/empty/Report_BFlaechenbindungen.frm | 10 - .../vba/empty/Report_BGebietshierarchie.frm | 10 - wgmaster/vba/empty/Report_BLeseplanung.frm | 10 - wgmaster/vba/empty/Report_BLieferjournal.frm | 10 - .../Report_BLieferjournalVerschluesselt.frm | 10 - wgmaster/vba/empty/Report_BLiefermenge.frm | 10 - wgmaster/vba/empty/Report_BLieferschein2.frm | 10 - wgmaster/vba/empty/Report_BLieferschein3.frm | 10 - wgmaster/vba/empty/Report_BLieferschein4.frm | 10 - .../empty/Report_BLieferstatistikProOrt.frm | 10 - .../vba/empty/Report_BMitgliedStammblatt.frm | 10 - ...rt_BMitgliedStammblattFlächenbindungen.frm | 10 - .../empty/Report_BMitgliedStammblattMGNR.frm | 10 - .../vba/empty/Report_BMitgliederliste.frm | 10 - .../empty/Report_BMitgliederlisteDetails.frm | 10 - .../vba/empty/Report_BMitgliederlisteTest.frm | 10 - ...Report_BMitgliederlisteVolllieferanten.frm | 10 - .../vba/empty/Report_BNulllieferungen.frm | 10 - .../vba/empty/Report_BQualitätsstatistik.frm | 10 - .../Report_BQualitätsstatistikRotWeiss.frm | 10 - .../vba/empty/Report_BQualitätsstufen.frm | 10 - wgmaster/vba/empty/Report_BRundschreiben.frm | 10 - wgmaster/vba/empty/Report_BSorten.frm | 10 - .../Report_BSortenStatistikAttribute.frm | 10 - .../vba/empty/Report_BSortenstatistik.frm | 10 - .../Report_BUeberweisungslisteBrutto.frm | 10 - wgmaster/vba/empty/Report_BUmrechnung.frm | 10 - ...Report_BUnterlieferungenFlächenbindung.frm | 10 - wgmaster/vba/empty/Report_BVorlage.frm | 10 - .../vba/empty/Report_BÜberlieferungen.frm | 10 - wgmaster/vba/form/Form_FAbschlaege.frm | 38 - wgmaster/vba/form/Form_FAllgemein.frm | 58 - wgmaster/vba/form/Form_FAuszahlung.frm | 1170 ------------- .../vba/form/Form_FAuszahlungParameter.frm | 166 -- wgmaster/vba/form/Form_FAuszahlungSorten.frm | 19 - .../form/Form_FAuszahlungSortenAuswahl.frm | 108 -- .../Form_FAuszahlungSortenQualitätsstufe.frm | 19 - wgmaster/vba/form/Form_FBanken.frm | 19 - .../vba/form/Form_FBewirtschaftungsarten.frm | 19 - wgmaster/vba/form/Form_FChargeUmfuellen.frm | 179 -- wgmaster/vba/form/Form_FChargen.frm | 70 - wgmaster/vba/form/Form_FFlaechenbindungen.frm | 24 - wgmaster/vba/form/Form_FGebiete.frm | 27 - wgmaster/vba/form/Form_FGebietshierarchie.frm | 345 ---- wgmaster/vba/form/Form_FGemeinden.frm | 27 - wgmaster/vba/form/Form_FGrosslagen.frm | 27 - wgmaster/vba/form/Form_FLeseplanung.frm | 52 - wgmaster/vba/form/Form_FLiefermengen.frm | 69 - wgmaster/vba/form/Form_FLieferungAbschlag.frm | 19 - wgmaster/vba/form/Form_FLieferungen.frm | 718 -------- wgmaster/vba/form/Form_FMandant.frm | 61 - wgmaster/vba/form/Form_FMitglieder.frm | 288 ---- wgmaster/vba/form/Form_FQualitaetsstufen.frm | 19 - wgmaster/vba/form/Form_FRegionen.frm | 27 - wgmaster/vba/form/Form_FRiede.frm | 26 - wgmaster/vba/form/Form_FRiedeMitglied.frm | 42 - wgmaster/vba/form/Form_FSorten.frm | 25 - .../form/Form_FSortenkuerzelUmbenennen.frm | 129 -- wgmaster/vba/form/Form_FTextelemente.frm | 36 - .../form/Form_FUebernahmeChargenauswahl.frm | 18 - wgmaster/vba/form/Form_FUmrechnung.frm | 19 - wgmaster/vba/form/Form_FÜbernahme.frm | 1485 ----------------- wgmaster/vba/form/Form_FÜbernahmeAbschlag.frm | 19 - wgmaster/vba/form/Form_MAbwertungen.frm | 38 - wgmaster/vba/form/Form_MAdministration.frm | 328 ---- .../vba/form/Form_MAdministrationCopy.frm | 328 ---- .../vba/form/Form_MAdministrationCopy2.frm | 326 ---- wgmaster/vba/form/Form_MAnlieferung.frm | 113 -- .../Form_MAnlieferungenJahresvergleich.frm | 137 -- wgmaster/vba/form/Form_MAuswertung.frm | 37 - .../vba/form/Form_MAuswertungMitglieder.frm | 129 -- wgmaster/vba/form/Form_MAuszahlung.frm | 29 - wgmaster/vba/form/Form_MAuszahlungAuswahl.frm | 515 ------ wgmaster/vba/form/Form_MChargenAuswahl.frm | 251 --- wgmaster/vba/form/Form_MChargenListe.frm | 263 --- wgmaster/vba/form/Form_MExport.frm | 310 ---- wgmaster/vba/form/Form_MExportAuszahlung.frm | 1370 --------------- wgmaster/vba/form/Form_MExportBKIListe.frm | 380 ----- wgmaster/vba/form/Form_MExportMitglieder.frm | 412 ----- wgmaster/vba/form/Form_MHauptmenü.frm | 113 -- wgmaster/vba/form/Form_MImport.frm | 659 -------- wgmaster/vba/form/Form_MLeseauswertung.frm | 342 ---- .../form/Form_MLieferscheinBereinigung.frm | 111 -- wgmaster/vba/form/Form_MLieferungAuswahl.frm | 148 -- wgmaster/vba/form/Form_MLieferungSuchen.frm | 78 - wgmaster/vba/form/Form_MMandantenauswahl.frm | 471 ------ .../vba/form/Form_MMitgliederKonsistenz.frm | 134 -- wgmaster/vba/form/Form_MMitgliederliste.frm | 113 -- wgmaster/vba/form/Form_MRundschreiben.frm | 143 -- .../vba/form/Form_MRundschreibenEMail.frm | 83 - wgmaster/vba/form/Form_MStammblatt.frm | 82 - wgmaster/vba/form/Form_MStammdaten.frm | 89 - wgmaster/vba/form/Form_MUnterlieferungen.frm | 287 ---- 132 files changed, 17624 deletions(-) delete mode 100644 wgmaster/vba/MAuszahlung.bas delete mode 100644 wgmaster/vba/MChargen.bas delete mode 100644 wgmaster/vba/MFlaechenbindungen.bas delete mode 100644 wgmaster/vba/MMigration.bas delete mode 100644 wgmaster/vba/MMisc.bas delete mode 100644 wgmaster/vba/MProperties.bas delete mode 100644 wgmaster/vba/MTanksanlegen.bas delete mode 100644 wgmaster/vba/MTcpSocket.bas delete mode 100644 wgmaster/vba/MWaage.bas delete mode 100644 wgmaster/vba/Report_BAuszahlung.frm delete mode 100644 wgmaster/vba/Report_BAuszahlungMGNR.frm delete mode 100644 wgmaster/vba/Report_BBuchungsliste.frm delete mode 100644 wgmaster/vba/Report_BUeberweisungsliste.frm delete mode 100644 wgmaster/vba/Report_Mitglieder-Information.frm delete mode 100644 wgmaster/vba/empty/Form_FBehaelter.frm delete mode 100644 wgmaster/vba/empty/Form_FChargenBehandlungen.frm delete mode 100644 wgmaster/vba/empty/Form_FGrosslagenGebieteSorten.frm delete mode 100644 wgmaster/vba/empty/Form_FMitgliedInfo.frm delete mode 100644 wgmaster/vba/empty/Form_FSortenAttribute.frm delete mode 100644 wgmaster/vba/empty/Form_FSortenAttributeEingabe.frm delete mode 100644 wgmaster/vba/empty/Form_FZweigstellen.frm delete mode 100644 wgmaster/vba/empty/Report_BAbschlaege.frm delete mode 100644 wgmaster/vba/empty/Report_BAbwertungen.frm delete mode 100644 wgmaster/vba/empty/Report_BAbwertungenMGNR.frm delete mode 100644 wgmaster/vba/empty/Report_BAbwertungenSorte.frm delete mode 100644 wgmaster/vba/empty/Report_BAnlieferungenJahresvergleichDetail.frm delete mode 100644 wgmaster/vba/empty/Report_BAnlieferungsbestaetigung.frm delete mode 100644 wgmaster/vba/empty/Report_BAnlieferungsbestaetigungMGNR.frm delete mode 100644 wgmaster/vba/empty/Report_BAuszahlungsvarianteKopf.frm delete mode 100644 wgmaster/vba/empty/Report_BAuszahlungsvarianteSorten.frm delete mode 100644 wgmaster/vba/empty/Report_BAuszahlungsvarianteSortenattribute.frm delete mode 100644 wgmaster/vba/empty/Report_BBanken.frm delete mode 100644 wgmaster/vba/empty/Report_BBehaelter.frm delete mode 100644 wgmaster/vba/empty/Report_BBewirtschaftungsarten.frm delete mode 100644 wgmaster/vba/empty/Report_BBuchungslisteBrutto.frm delete mode 100644 wgmaster/vba/empty/Report_BChargenListe.frm delete mode 100644 wgmaster/vba/empty/Report_BChargenStammblatt.frm delete mode 100644 wgmaster/vba/empty/Report_BChargenStammblattBehandlungen.frm delete mode 100644 wgmaster/vba/empty/Report_BChargenStammblattLieferungen.frm delete mode 100644 wgmaster/vba/empty/Report_BFlaechenbindungen.frm delete mode 100644 wgmaster/vba/empty/Report_BGebietshierarchie.frm delete mode 100644 wgmaster/vba/empty/Report_BLeseplanung.frm delete mode 100644 wgmaster/vba/empty/Report_BLieferjournal.frm delete mode 100644 wgmaster/vba/empty/Report_BLieferjournalVerschluesselt.frm delete mode 100644 wgmaster/vba/empty/Report_BLiefermenge.frm delete mode 100644 wgmaster/vba/empty/Report_BLieferschein2.frm delete mode 100644 wgmaster/vba/empty/Report_BLieferschein3.frm delete mode 100644 wgmaster/vba/empty/Report_BLieferschein4.frm delete mode 100644 wgmaster/vba/empty/Report_BLieferstatistikProOrt.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliedStammblatt.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliedStammblattFlächenbindungen.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliedStammblattMGNR.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliederliste.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliederlisteDetails.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliederlisteTest.frm delete mode 100644 wgmaster/vba/empty/Report_BMitgliederlisteVolllieferanten.frm delete mode 100644 wgmaster/vba/empty/Report_BNulllieferungen.frm delete mode 100644 wgmaster/vba/empty/Report_BQualitätsstatistik.frm delete mode 100644 wgmaster/vba/empty/Report_BQualitätsstatistikRotWeiss.frm delete mode 100644 wgmaster/vba/empty/Report_BQualitätsstufen.frm delete mode 100644 wgmaster/vba/empty/Report_BRundschreiben.frm delete mode 100644 wgmaster/vba/empty/Report_BSorten.frm delete mode 100644 wgmaster/vba/empty/Report_BSortenStatistikAttribute.frm delete mode 100644 wgmaster/vba/empty/Report_BSortenstatistik.frm delete mode 100644 wgmaster/vba/empty/Report_BUeberweisungslisteBrutto.frm delete mode 100644 wgmaster/vba/empty/Report_BUmrechnung.frm delete mode 100644 wgmaster/vba/empty/Report_BUnterlieferungenFlächenbindung.frm delete mode 100644 wgmaster/vba/empty/Report_BVorlage.frm delete mode 100644 wgmaster/vba/empty/Report_BÜberlieferungen.frm delete mode 100644 wgmaster/vba/form/Form_FAbschlaege.frm delete mode 100644 wgmaster/vba/form/Form_FAllgemein.frm delete mode 100644 wgmaster/vba/form/Form_FAuszahlung.frm delete mode 100644 wgmaster/vba/form/Form_FAuszahlungParameter.frm delete mode 100644 wgmaster/vba/form/Form_FAuszahlungSorten.frm delete mode 100644 wgmaster/vba/form/Form_FAuszahlungSortenAuswahl.frm delete mode 100644 wgmaster/vba/form/Form_FAuszahlungSortenQualitätsstufe.frm delete mode 100644 wgmaster/vba/form/Form_FBanken.frm delete mode 100644 wgmaster/vba/form/Form_FBewirtschaftungsarten.frm delete mode 100644 wgmaster/vba/form/Form_FChargeUmfuellen.frm delete mode 100644 wgmaster/vba/form/Form_FChargen.frm delete mode 100644 wgmaster/vba/form/Form_FFlaechenbindungen.frm delete mode 100644 wgmaster/vba/form/Form_FGebiete.frm delete mode 100644 wgmaster/vba/form/Form_FGebietshierarchie.frm delete mode 100644 wgmaster/vba/form/Form_FGemeinden.frm delete mode 100644 wgmaster/vba/form/Form_FGrosslagen.frm delete mode 100644 wgmaster/vba/form/Form_FLeseplanung.frm delete mode 100644 wgmaster/vba/form/Form_FLiefermengen.frm delete mode 100644 wgmaster/vba/form/Form_FLieferungAbschlag.frm delete mode 100644 wgmaster/vba/form/Form_FLieferungen.frm delete mode 100644 wgmaster/vba/form/Form_FMandant.frm delete mode 100644 wgmaster/vba/form/Form_FMitglieder.frm delete mode 100644 wgmaster/vba/form/Form_FQualitaetsstufen.frm delete mode 100644 wgmaster/vba/form/Form_FRegionen.frm delete mode 100644 wgmaster/vba/form/Form_FRiede.frm delete mode 100644 wgmaster/vba/form/Form_FRiedeMitglied.frm delete mode 100644 wgmaster/vba/form/Form_FSorten.frm delete mode 100644 wgmaster/vba/form/Form_FSortenkuerzelUmbenennen.frm delete mode 100644 wgmaster/vba/form/Form_FTextelemente.frm delete mode 100644 wgmaster/vba/form/Form_FUebernahmeChargenauswahl.frm delete mode 100644 wgmaster/vba/form/Form_FUmrechnung.frm delete mode 100644 wgmaster/vba/form/Form_FÜbernahme.frm delete mode 100644 wgmaster/vba/form/Form_FÜbernahmeAbschlag.frm delete mode 100644 wgmaster/vba/form/Form_MAbwertungen.frm delete mode 100644 wgmaster/vba/form/Form_MAdministration.frm delete mode 100644 wgmaster/vba/form/Form_MAdministrationCopy.frm delete mode 100644 wgmaster/vba/form/Form_MAdministrationCopy2.frm delete mode 100644 wgmaster/vba/form/Form_MAnlieferung.frm delete mode 100644 wgmaster/vba/form/Form_MAnlieferungenJahresvergleich.frm delete mode 100644 wgmaster/vba/form/Form_MAuswertung.frm delete mode 100644 wgmaster/vba/form/Form_MAuswertungMitglieder.frm delete mode 100644 wgmaster/vba/form/Form_MAuszahlung.frm delete mode 100644 wgmaster/vba/form/Form_MAuszahlungAuswahl.frm delete mode 100644 wgmaster/vba/form/Form_MChargenAuswahl.frm delete mode 100644 wgmaster/vba/form/Form_MChargenListe.frm delete mode 100644 wgmaster/vba/form/Form_MExport.frm delete mode 100644 wgmaster/vba/form/Form_MExportAuszahlung.frm delete mode 100644 wgmaster/vba/form/Form_MExportBKIListe.frm delete mode 100644 wgmaster/vba/form/Form_MExportMitglieder.frm delete mode 100644 wgmaster/vba/form/Form_MHauptmenü.frm delete mode 100644 wgmaster/vba/form/Form_MImport.frm delete mode 100644 wgmaster/vba/form/Form_MLeseauswertung.frm delete mode 100644 wgmaster/vba/form/Form_MLieferscheinBereinigung.frm delete mode 100644 wgmaster/vba/form/Form_MLieferungAuswahl.frm delete mode 100644 wgmaster/vba/form/Form_MLieferungSuchen.frm delete mode 100644 wgmaster/vba/form/Form_MMandantenauswahl.frm delete mode 100644 wgmaster/vba/form/Form_MMitgliederKonsistenz.frm delete mode 100644 wgmaster/vba/form/Form_MMitgliederliste.frm delete mode 100644 wgmaster/vba/form/Form_MRundschreiben.frm delete mode 100644 wgmaster/vba/form/Form_MRundschreibenEMail.frm delete mode 100644 wgmaster/vba/form/Form_MStammblatt.frm delete mode 100644 wgmaster/vba/form/Form_MStammdaten.frm delete mode 100644 wgmaster/vba/form/Form_MUnterlieferungen.frm diff --git a/wgmaster/vba/MAuszahlung.bas b/wgmaster/vba/MAuszahlung.bas deleted file mode 100644 index 13c5f4e..0000000 --- a/wgmaster/vba/MAuszahlung.bas +++ /dev/null @@ -1,522 +0,0 @@ -Option Compare Database -Option Explicit - -Sub GebundenBerechnen(Jahr1 As Long, SortenattributeBeiFlächenbindungOptional As Boolean, GebundenBerücksichtigen As Boolean) - - Dim db1 As Database - Dim rs1 As Recordset - Dim rs2 As Recordset - Dim rs3 As Recordset - - Dim actMGNR As Long - Dim actSNR As String - Dim actSANR As String - Dim rsSANR As String - Dim actLieferrecht As Double - Dim actLieferrecht_Attribute(0 To 255) As Double - Dim actLieferungGebunden As Double - Dim actBetrag As Double - Dim GewichtGebunden As Double - Dim GewichtGebundenGrundsorte As Double - Dim test1 - - - Dim ErgebnisGewicht As Double - Dim ErgebnisBetrag As Double - Dim ErgebnisGebunden As Double - Dim ErgebnisDatensaetze As Double - Dim ErgebnisAktDatensatz As Double - - Dim query1 As String - Dim query2 As String - Dim zwi - Dim maxertrag As Double - Dim KgProHa - Dim attribute_count As Long - Dim i As Long - Dim j As Long - Dim ImmerUngebunden As Boolean - - - -DoCmd.Hourglass True - - - 'maxertrag = GetParameter("MAXERTRAG") - - Set db1 = CurrentDb - - query1 = "SELECT * FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(Jahr1) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR;" - 'query1 = "SELECT * FROM (TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR) LEFT JOIN TSortenAttribute ON TLieferungen.SANR = TSortenAttribute.SANR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(jahr1) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR;" - Set rs1 = db1.OpenRecordset(query1) - - actMGNR = -1 - actSNR = "" - actSANR = "" - - - While Not rs1.EOF - - rs1.Edit - - If actMGNR <> rs1![TLieferungen.MGNR] Then - ' Nächstes Mitglied - actMGNR = rs1![TLieferungen.MGNR] - actSNR = "----" - actSANR = "----" - End If - - If Not IsNull(rs1![SANR]) And rs1!SANR <> "" Then - rsSANR = UCase(rs1![SANR]) - ImmerUngebunden = DFirst("ImmerUngebunden", "TSortenAttribute", "SANR='" + rsSANR + "'") - Else - rsSANR = "" - ImmerUngebunden = False - End If - - GewichtGebunden = 0 - GewichtGebundenGrundsorte = 0 - - If SortenattributeBeiFlächenbindungOptional = True Then - - 'A Sortenattribute in Flaechenbindung optional - - actSANR = rsSANR - - 'Feststellen der Lieferrechte bei Sortenwechsel - If actSNR <> UCase(rs1![TLieferungen.SNR]) Then - - actSNR = UCase(rs1![TLieferungen.SNR]) - - KgProHa = DFirst("kgproHa", "TSorten", "SNR='" + actSNR + "'") - - 'maxertrag für Grundsorte bestimmen - If Not IsNull(KgProHa) And KgProHa > 0 Then - maxertrag = KgProHa - Else - maxertrag = GetParameter("MAXERTRAG") - End If - - 'Lieferrecht für Grundsorte errechnen - zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") - If IsNull(zwi) Then - actLieferrecht = 0 - zwi = 0 - Else - actLieferrecht = zwi * maxertrag / 10000 - End If - - 'maxertrag für jedes Attribut bestimmen - Set rs3 = db1.OpenRecordset("SELECT * FROM TSortenattribute ORDER BY SANR") - i = 0 - While Not rs3.EOF - KgProHa = rs3("kgproha") - If Not IsNull(KgProHa) And KgProHa > 0 Then - actLieferrecht_Attribute(i) = zwi * KgProHa / 10000 - Else - actLieferrecht_Attribute(i) = zwi * GetParameter("MAXERTRAG") / 10000 - End If - rs3.MoveNext - i = i + 1 - Wend - rs3.Close - attribute_count = i - End If - - - If rs1!QSNR >= 3 And (rs1!gebunden = True Or GebundenBerücksichtigen = False) Then - - If actSANR = "" Then - 'Grundsorte - - If rs1!Gewicht < actLieferrecht Then - ' Alles - GewichtGebunden = rs1!Gewicht - actLieferrecht = actLieferrecht - GewichtGebunden - - 'auch für alle Attribute Lieferrecht reduzieren - For i = 0 To attribute_count - 1 - actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden - Next i - - Else - If actLieferrecht > 0 Then - ' Ein Teil - GewichtGebunden = actLieferrecht - actLieferrecht = 0 - 'auch für alle Attribute Lieferrecht reduzieren - For i = 0 To attribute_count - 1 - actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden - Next i - - Else - ' Kein geb. Lieferrecht mehr übrig - GewichtGebunden = 0 - End If - End If - Else - 'Sortenattribut - - 'Nur wenn Attribut nicht ohnehin Ungebunden - If ImmerUngebunden = False Then - - 'richtigen Eintrag finden - Set rs3 = db1.OpenRecordset("SELECT * FROM TSortenattribute ORDER BY SANR") - j = 0 - While Not rs3.EOF And rs3("SANR") <> actSANR - rs3.MoveNext - j = j + 1 - Wend - rs3.Close - If j > attribute_count Then - 'error - MsgBox ("Fehler bei Attributen!") - End If - - If rs1!Gewicht < actLieferrecht_Attribute(j) Then - ' Alles - GewichtGebunden = rs1!Gewicht - actLieferrecht = actLieferrecht - GewichtGebunden - - 'auch für alle Attribute Lieferrecht reduzieren - For i = 0 To attribute_count - 1 - actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden - Next i - - Else - If actLieferrecht_Attribute(j) > 0 Then - ' Ein Teil - GewichtGebunden = actLieferrecht_Attribute(j) - 'Lieferrecht bei Grundsorte reduzieren - actLieferrecht = actLieferrecht - GewichtGebunden - 'auch für alle Attribute Lieferrecht reduzieren - For i = 0 To attribute_count - 1 - actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden - Next i - - Else - ' Kein geb. Lieferrecht mehr übrig - GewichtGebunden = 0 - End If - End If - - 'Versuche, Rest auf Grundsorte zu verbuchen - If GewichtGebunden < rs1!Gewicht And actLieferrecht > 0 Then - - If rs1!Gewicht - GewichtGebunden < actLieferrecht Then - ' Alles - GewichtGebundenGrundsorte = rs1!Gewicht - GewichtGebunden - actLieferrecht = actLieferrecht - GewichtGebundenGrundsorte - - 'auch für alle Attribute Lieferrecht reduzieren - For i = 0 To attribute_count - 1 - actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebundenGrundsorte - Next i - - Else - If actLieferrecht > 0 Then - ' Ein Teil - GewichtGebundenGrundsorte = actLieferrecht - actLieferrecht = 0 - 'auch für alle Attribute Lieferrecht reduzieren - For i = 0 To attribute_count - 1 - actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebundenGrundsorte - Next i - - Else - ' Kein geb. Lieferrecht mehr übrig - GewichtGebundenGrundsorte = 0 - End If - End If - - - End If - - End If - - End If - - Else - ' Kein Qualitätswein - GewichtGebunden = 0 - End If - - - 'MsgBox (Format(rs1!Gewicht) + " " + Format(rs1!Gebunden) + " " + Format(GewichtGebunden)) - - If IsNull(GewichtGebunden) Then GewichtGebunden = 0 - If IsNull(GewichtGebundenGrundsorte) Then GewichtGebundenGrundsorte = 0 - - 'rounding - If CLng(GewichtGebunden) < GewichtGebunden Then - GewichtGebunden = CLng(GewichtGebunden) + 1 - Else - GewichtGebunden = CLng(GewichtGebunden) - End If - GewichtGebundenGrundsorte = Int(GewichtGebundenGrundsorte) - - - rs1!BGewichtGebunden = GewichtGebunden - rs1!BGewichtGebundenGrundsorte = GewichtGebundenGrundsorte - - rs1.Update - - - Else - 'B Strikt = Sortenattribute in Flaechenbindung NICHT optional - - 'Feststellen der Lieferrechte bei Sorten oder Attributswechsel - If actSNR <> UCase(rs1![TLieferungen.SNR]) Or (actSANR <> rsSANR) Then - ' Nächste Sorte oder Attribut - actSNR = UCase(rs1![TLieferungen.SNR]) - actSANR = rsSANR - - 'maxertrag setzen - If actSANR <> "" Then - 'from Sortenattribut - KgProHa = DFirst("kgproHa", "TSortenattribute", "SANR='" + rsSANR + "'") - If Not IsNull(KgProHa) And KgProHa > 0 Then - maxertrag = KgProHa - Else - maxertrag = GetParameter("MAXERTRAG") - End If - zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND SANR='" + actSANR + "' AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") * maxertrag / 10000 - Else - 'from Sorte - If Not IsNull(rs1!KgProHa) And rs1!KgProHa > 0 Then - maxertrag = rs1!KgProHa - Else - maxertrag = GetParameter("MAXERTRAG") - End If - zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND (Isnull(SANR) or SANR='') AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") * maxertrag / 10000 - End If - - - If IsNull(zwi) Then - actLieferrecht = 0 - Else - actLieferrecht = zwi - End If - actLieferungGebunden = 0 - End If - - ' actLieferungGewicht - - - - 'Wieviel ist gebunden ? - - - If rs1!QSNR >= 3 And (rs1!gebunden = True Or GebundenBerücksichtigen = False) And ImmerUngebunden = False Then - - If rs1!Gewicht < actLieferrecht - actLieferungGebunden Then - ' Alles - GewichtGebunden = rs1!Gewicht - actLieferungGebunden = actLieferungGebunden + GewichtGebunden - Else - If actLieferungGebunden < actLieferrecht Then - ' Ein Teil - GewichtGebunden = actLieferrecht - actLieferungGebunden - actLieferungGebunden = actLieferrecht - Else - ' Kein geb. Lieferrecht mehr übrig - GewichtGebunden = 0 - End If - End If - Else - ' Kein Qualitätswein - GewichtGebunden = 0 - End If - - - 'MsgBox (Format(rs1!Gewicht) + " " + Format(rs1!Gebunden) + " " + Format(GewichtGebunden)) - - If IsNull(GewichtGebunden) Then GewichtGebunden = 0 - - 'round up - If CLng(GewichtGebunden) < GewichtGebunden Then - GewichtGebunden = CLng(GewichtGebunden) + 1 - Else - GewichtGebunden = CLng(GewichtGebunden) - End If - - rs1!BGewichtGebunden = GewichtGebunden - rs1!BGewichtGebundenGrundsorte = 0 - rs1.Update - - End If - - rs1.MoveNext - - Wend - - rs1.Close - - - -DoCmd.Hourglass False - - -End Sub - - - - -Sub Auszahlung2015_MwStUmstellen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim faktor As Double -Dim Buchführend As Boolean -Dim summe1 As Double -Dim summe2 As Double - - -Set db1 = CurrentDb - -'1. originaldaten sichern -db1.Execute ("DROP TABLE xTempLieferungen") -db1.Execute ("CREATE TABLE xTempLieferungen (LINR Integer, MGNR Integer, BTeilzahlung1 DOUBLE, BBetragGebunden DOUBLE, BBetragUngebunden DOUBLE,BTeilzahlung1_neu DOUBLE, BBetragGebunden_neu DOUBLE, BBetragUngebunden_neu DOUBLE, Korrekturbetrag DOUBLE,GesamtBrutto DOUBLE, GesamtBrutto_neu DOUBLE, GesamtBrutto_neu_korrigiert DOUBLE)") -db1.Execute ("DELETE * FROM xTempLieferungen") -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungen where datum>Datevalue('01.01.2015') order by LINR") -Set rs2 = db1.OpenRecordset("xTempLieferungen") - -While Not rs1.EOF - rs2.AddNew - rs2("LINR") = rs1("LINR") - rs2("MGNR") = rs1("MGNR") - rs2("BTeilzahlung1") = rs1("BTeilzahlung1") - rs2("BBetragGebunden") = rs1("BBetragGebunden") - rs2("BBetragUngebunden") = rs1("BBetragUngebunden") - rs2.Update - rs1.MoveNext -Wend -rs1.Close -rs2.Close - -'2. nettobeträge korrigieren -Set rs1 = db1.OpenRecordset("SELECT TLieferungen.* FROM TLieferungen WHERE MGNR>0 AND datum>Datevalue('01.01.2015') order by LINR") -While Not rs1.EOF - Buchführend = DFirst("Buchführend", "TMitglieder", "MGNR=" + Format(rs1("MGNR"))) - 'If buchführend Then - ' faktor = 1 - 'Else - faktor = 1.13 / 1.12 - 'End If - Set rs2 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE LINR=" + Format(rs1("LINR"))) - rs2.Edit - rs2("BTeilzahlung1_neu") = rs1("BTeilzahlung1") * faktor - rs2("BBetragGebunden_neu") = rs1("BBetragGebunden") * faktor - rs2("BBetragUngebunden_neu") = rs1("BBetragUngebunden") * faktor - rs2("Korrekturbetrag") = 0 - rs2.Update - rs1.MoveNext -Wend - rs1.Close -rs2.Close - -'3. runden für gleichen Betrag -Set rs1 = db1.OpenRecordset("SELECT DISTINCT MGNR FROM TLieferungen WHERE MGNR>0 AND MGNR NOT IN (SELECT MGNR FROM TMitglieder WHERE Buchführend=True) AND datum>Datevalue('01.01.2015') order by MGNR") -While Not rs1.EOF - - summe1 = DSum("BTeilzahlung1", "xTempLieferungen", "MGNR=" + Format(rs1("MGNR"))) - summe2 = 0 - If summe1 <> 0 Then - Set rs2 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE MGNR=" + Format(rs1("MGNR"))) - - While Not rs2.EOF - - rs2.Edit - rs2("BTeilzahlung1_neu") = Runden(rs2("BTeilzahlung1_neu"), 2) - If Not IsNull(rs2("BBetragGebunden_neu")) Then - rs2("BBetragGebunden_neu") = Runden(rs2("BBetragGebunden_neu"), 3) - End If - If Not IsNull(rs2("BBetragUngebunden_neu")) Then - rs2("BBetragUngebunden_neu") = Runden(rs2("BBetragUngebunden_neu"), 3) - End If - summe2 = summe2 + rs2("BTEilzahlung1_neu") - rs2.Update - rs2.MoveNext - Wend - rs2.MovePrevious - 'letzten Eintrag auf korrekte Summe korrigieren - rs2.Edit - 'rs2("Korrekturbetrag") = (summe2 * 1.12 - summe1 * 1.13) / 1.12 - rs2("Korrekturbetrag") = Runden((Runden(summe2 * 1.12, 2) - Runden(summe1 * 1.13, 2)) / 1.12, 2) - rs2("GesamtBrutto") = Runden(summe1 * 1.13, 2) - rs2("GesamtBrutto_neu") = Runden(summe2 * 1.12, 2) - rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2) - - If rs2("GesamtBrutto_neu_korrigiert") > rs2("GesamtBrutto") Then - rs2("Korrekturbetrag") = rs2("Korrekturbetrag") + 0.01 - rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2) - End If - If rs2("GesamtBrutto_neu_korrigiert") < rs2("GesamtBrutto") Then - rs2("Korrekturbetrag") = rs2("Korrekturbetrag") - 0.01 - rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2) - End If - rs2.Update - - rs2.Close - - End If - rs1.MoveNext -Wend -rs1.Close - -'Exit Sub -'4. Rückübertragung in TLieferungen -Set rs1 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE BTeilzahlung1>0 ORDER BY LINR") -While Not rs1.EOF - Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen where LINR=" + Format(rs1("LINR"))) - If Not rs2.EOF Then - rs2.Edit - rs2("BTeilzahlung1") = Runden(rs1("BTeilzahlung1_neu") - rs1("Korrekturbetrag"), 2) - rs2("BBetragGebunden") = rs1("BBetragGebunden_neu") - rs2("BBetragUngebunden") = rs1("BBetragUngebunden_neu") - rs2.Update - End If - rs2.Close - rs1.MoveNext -Wend -rs1.Close - -End Sub - - -Sub Auszahlung2015_NettoPreiseProKg_anheben() - -Dim db1 As Database -Dim rs1 As Recordset - -Dim faktor As Double - -Set db1 = CurrentDb -faktor = 1.13 / 1.12 -Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=140") -While Not rs1.EOF -rs1.Edit -If Not IsNull(rs1("Betrag")) Then - rs1("Betrag") = Runden(faktor * rs1("Betrag"), 3) -End If -rs1.Update -rs1.MoveNext -Wend -rs1.Close - -Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSortenQualitätsstufe WHERE AZNR=140") -While Not rs1.EOF -rs1.Edit -If Not IsNull(rs1("Betrag")) Then - rs1("Betrag") = Runden(faktor * rs1("Betrag"), 3) -End If -rs1.Update -rs1.MoveNext -Wend -rs1.Close - - - -End Sub - diff --git a/wgmaster/vba/MChargen.bas b/wgmaster/vba/MChargen.bas deleted file mode 100644 index e6afe0b..0000000 --- a/wgmaster/vba/MChargen.bas +++ /dev/null @@ -1,613 +0,0 @@ -Option Compare Database -Option Explicit - -Function GetActiveCharge(SNR1 As String, QSNR1 As Long, ZNR1 As Long, Optional ByVal SANR1 As Variant) As Long - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb - -'1. Suche nach Charge, die alle Kriterien erfüllt -If Not IsNull(SANR1) And SANR1 <> "" Then - Set rs1 = db1.OpenRecordset("SELECT * FROM TChargen WHERE SNR='" + SNR1 + "' AND SANR='" + SANR1 + "' AND (QSNRVon<=" + Format(QSNR1) + " OR ISNULL(QSNRVon)) AND (QSNRBis>=" + Format(QSNR1) + " OR IsNull(QSNRBis)) AND ZNR=" + Format(ZNR1) + " AND CSNR=2") -Else - Set rs1 = db1.OpenRecordset("SELECT * FROM TChargen WHERE SNR='" + SNR1 + "' AND (QSNRVon<=" + Format(QSNR1) + " OR ISNULL(QSNRVon)) AND (QSNRBis>=" + Format(QSNR1) + " OR IsNull(QSNRBis)) AND ZNR=" + Format(ZNR1) + " AND CSNR=2") -End If -If rs1.EOF Then - GetActiveCharge = -1 -Else - GetActiveCharge = rs1("CNR") -End If -rs1.Close - -End Function - -Public Function ChargeBefuellen(CNR1 As Long, LINR1 As Long) As Boolean - -Dim db1 As Database -Dim rsc As Recordset -Dim rsl As Recordset -Dim rsb As Recordset -Dim verbuchen As Boolean - -ChargeBefuellen = False -Set db1 = CurrentDb - -'1. Öffnen der Datensätze -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1)) -If rsc.EOF Then - rsc.Close - MsgBox ("Charge nicht gefunden!") - Exit Function -End If - -Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1)) -If rsl.EOF Then - rsl.Close - MsgBox ("Lieferung nicht gefunden!") - Exit Function -End If - -Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsc("BNR"))) -If rsb.EOF Then - rsb.Close - MsgBox ("Behälter nicht gefunden!") - Exit Function -End If - -'2. Überprüfen, ob Charge im richtigen Status und Lieferung zugeordnet -'TODO -'Charge im Status 2? -'Lieferung ist diese Charge zugeordnet? -'Chargentyp=Maische? - - -If rsl("AufChargeVerbucht") = True Then - If MsgBox("Diese Lieferung wurde bereits verbucht! Sind Sie sicher, diese Lieferung nochmals zu verbuchen?", vbYesNo) = vbYes Then - verbuchen = True - Else - verbuchen = False - End If -Else - verbuchen = True -End If - - -'3. Aktualisierung Menge und Oechsle unter Berücksichtigung des Reduktionsfaktors -If verbuchen = True Then - - rsc.Edit - If IsNull(rsc("Oechsle")) Or IsNull(rsc("Menge")) Then - 'erste lieferung - rsc("Oechsle") = rsl("Oechsle") - rsc("Menge") = rsl("Gewicht") - Else - rsc("Oechsle") = (rsc("Menge") * rsc("Oechsle") + rsl("Gewicht") * rsl("Oechsle")) / (rsc("Menge") + rsl("Gewicht")) - rsc("Menge") = rsc("Menge") + rsl("Gewicht") - - End If - - - '4. Überprüfung der Charge, ob voll wird - 'If rsc("Menge") > rsb("MaxMenge") And GetParameter("CHARGENWARNUNG_BEHAELTERVOLL") = "Ja" Then - ' If MsgBox("Der Behälter der ausgewählten Charge wird mit dieser Lieferung überfüllt! Wollen Sie die Befüllung trotzdem durchführen?", vbYesNo) = vbYes Then - ' rsc.update - ' Else - ' End If - 'Else - rsc.Update - - '5. Aktualisieren der Lieferung - 'rsl.Edit - 'rsl("AufChargeVerbucht") = True - 'rsl.Update - ChargeBefuellen = True -End If - - -rsc.Close -rsb.Close -rsl.Close - -End Function - -Public Sub ChargeBefuellungRueckgaengig(CNR1 As Long, LINR1 As Long) - -Dim db1 As Database -Dim rsc As Recordset -Dim rsl As Recordset -Dim rsb As Recordset -Dim verbuchen As Boolean - -Set db1 = CurrentDb - -'1. Öffnen der Datensätze -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1)) -If rsc.EOF Then - rsc.Close - MsgBox ("Charge nicht gefunden!") - Exit Sub -End If - -Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1)) -If rsl.EOF Then - rsl.Close - MsgBox ("Lieferung nicht gefunden!") - Exit Sub -End If - -If rsl("AufChargeVerbucht") = False Then - If MsgBox("Diese Lieferung wurde noch gar nicht verbucht! Sind Sie sicher, die Verbuchung rückgängig zu machen?", vbYesNo) = vbYes Then - verbuchen = True - Else - verbuchen = False - End If -Else - verbuchen = True -End If - -If verbuchen = True Then -'2. Aktualisierung Menge und Oechsle unter Berücksichtigung des Reduktionsfaktors -rsc.Edit -If rsc("Oechsle") > 0 And rsc("Menge") > rsl("Gewicht") Then - rsc("Oechsle") = (rsc("Oechsle") * rsc("Menge") - rsl("Gewicht") * rsl("Oechsle")) / (rsc("Menge") - rsl("Gewicht")) - rsc("Menge") = rsc("Menge") - rsl("Gewicht") -End If -rsc.Update - -'3. Verbuchung Kennzeichnung aufheben -rsl.Edit -rsl("AufChargeVerbucht") = False -rsl.Update -End If - - -rsc.Close -rsl.Close - -End Sub - - - -Function NeueCharge(Optional Lesejahr As Long) As Long - -Dim db1 As Database -Dim rsc As Recordset -Dim CNR1 As Long - -Set db1 = CurrentDb - -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen") - -'If rsc.recordcount = 0 Then -' CNR1 = 1 -'Else -' CNR1 = DMax("CNR", "TChargen") + 1 -'End If - -rsc.AddNew -'rsc("CNR") = CNR1 -NeueCharge = rsc("CNR") -rsc("Menge") = 0 -rsc("ZNR") = GetParameter("LETZTEZNR") -If Lesejahr > 0 Then - rsc("Jahrgang") = Lesejahr -End If -rsc("CSNR") = 1 -rsc("Art") = "Maische" -rsc.Update -rsc.Close - -End Function - -Function ChargeClonen(CNR1 As Long, BNR1 As Long, Optional Menge1 As Long, Optional Oechsle1 As Long) As Long -Dim db1 As Database -Dim rsc As Recordset -Dim rsc2 As Recordset -Dim i -Dim Maxcounter1 As Long -Set db1 = CurrentDb -Dim CNR2 As Long -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen where CNR=" + Format(CNR1)) -Set rsc2 = db1.OpenRecordset("SELECT * FROM TChargen") - -If Not rsc.EOF Then - rsc2.AddNew - For i = 0 To rsc2.Fields.Count - 1 - If rsc2.Fields(i).Name <> "Chargennummer" And rsc2.Fields(i).Name <> "CNR" And rsc2.Fields(i).Name <> "BNR" Then - rsc2.Fields(i) = rsc.Fields(i) - End If - Next i - 'CNR2 = DMax("CNR", "TChargen") + 1 - 'rsc2("CNR") = CNR2 - ChargeClonen = rsc2("CNR") - CNR2 = rsc2("CNR") - rsc2("BNR") = BNR1 - If Not IsNull(Menge1) Then - rsc2("Menge") = Menge1 - End If - If Not IsNull(Oechsle1) Then - rsc2("Oechsle") = Oechsle1 - End If - rsc2("CSNR") = 2 - rsc2.Update - rsc2.Close - Set rsc2 = db1.OpenRecordset("SELECT * FROM TChargen where CNR=" + Format(CNR2)) - rsc2.Edit - rsc2("Chargennummer") = GeneriereChargennummer(rsc2("CNR"), Maxcounter1) - rsc2("ChargennummerZaehler") = Maxcounter1 - rsc2.Update -End If -rsc.Close -rsc2.Close - - - -End Function - - -Function GeneriereChargennummer(CNR1 As Long, Optional Maxcounter1 As Long) As String - -Dim db1 As Database -Dim rsc As Recordset -Dim Chargennummer As String -Dim Maxcounter As Long - -Set db1 = CurrentDb - -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1)) - -Select Case GetParameter("CHARGENNUMMERTYP") - -Case "1": 'BehälterKurzbezeichnung + Zähler (pro Behälter)+ DatumBefüllung - - If rsc("BNR") > 0 And rsc("Jahrgang") > 0 Then - If IsNull(DMax("ChargennummerZaehler", "TChargen", "BNR=" + Format(rsc("BNR")) + " AND Jahrgang=" + Format(rsc("Jahrgang")))) Then - Maxcounter = 0 - Else - Maxcounter = DMax("ChargennummerZaehler", "TChargen", "BNR=" + Format(rsc("BNR")) + " AND Jahrgang=" + Format(rsc("Jahrgang"))) - End If - Chargennummer = DFirst("Kurzbezeichnung", "TBehaelter", "BNR=" + Format(rsc("BNR"))) + "-" + Format(Maxcounter + 1, "0000") + "-" + Format(year(Date), "0000") + Format(Month(Date), "00") + Format(Day(Date), "00") - Maxcounter1 = Maxcounter + 1 - End If - -Case "2": - - -Case "3": - - -End Select - -rsc.Close -GeneriereChargennummer = Chargennummer - -End Function - - -Sub ChargeBefuellungStarten(CNR1 As Long) - -Dim db1 As Database -Dim rsc As Recordset - -Set db1 = CurrentDb - -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1)) - -If Not rsc.EOF Then - - 'div. Abfragen - If rsc("CSNR") <> 1 Then - MsgBox "Die Befüllung kann nur aus dem Zustand 'Erstellt' aus starten!", vbCritical - rsc.Close - Exit Sub - End If - - If IsNull(rsc("BNR")) Then - MsgBox "Bitte zuerst einen Behälter zuweisen!", vbCritical - rsc.Close - Exit Sub - End If - - - rsc.Edit - rsc("CSNR") = 2 - rsc("Befuellungsbeginn") = Date - rsc.Update - -End If -rsc.Close - - - - -End Sub - -Sub ChargeBefuellungBeenden(CNR1 As Long) - -Dim db1 As Database -Dim rsc As Recordset - -Set db1 = CurrentDb - -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1)) - -If Not rsc.EOF Then - - 'div. Abfragen - If rsc("CSNR") <> 2 Then - MsgBox "Die Befüllung kann nur aus dem Zustand 'Befüllung' aus beendet werden!", vbCritical - rsc.Close - Exit Sub - End If - - rsc.Edit - rsc("CSNR") = 3 - rsc("Befuellungsende") = Date - rsc.Update - -End If -rsc.Close - - -End Sub - - -Sub ChargenErstellenAusPlanung(date1 As Date) - -Dim db1 As Database -Dim rsp As Recordset -Dim rsc As Recordset -Dim CNR1 As Long -Dim CSNR1 As Long - -Set db1 = CurrentDb -Set rsp = db1.OpenRecordset("SELECT * FROM TLeseplanung WHERE Datum=DateValue('" + Format(date1) + "') ORDER BY SNR") -If rsp.EOF Then - MsgBox "Keine Planung für diesen Tag gefunden!", vbCritical - rsp.Close - Exit Sub -End If - -If MsgBox("Wollen Sie die Chargen gleich zur Befüllung freigeben?", vbYesNo) = vbYes Then - CSNR1 = 2 -Else - CSNR1 = 1 -End If - -While Not rsp.EOF - - CNR1 = NeueCharge(year(rsp("Datum"))) - Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1)) - rsc.Edit - rsc("SNR") = rsp("SNR") - If Not IsNull(rsp("SANR")) Then - rsc("SANR") = rsp("SANR") - End If - rsc("Befuellungsbeginn") = rsp("Datum") - rsc("Jahrgang") = year(rsp("Datum")) - If Not IsNull(rsp("QSNRVon")) Then - rsc("QSNRVon") = rsp("QSNRVon") - End If - If Not IsNull(rsp("QSNRBis")) Then - rsc("QSNRBis") = rsp("QSNRBis") - End If - rsc("CSNR") = CSNR1 - - rsc.Update - rsc.Close - rsp.MoveNext -Wend -rsp.Close -MsgBox ("Bitte den Chargen noch Behälter zuordnen") - -End Sub - - -Sub ChargeUmfuellen(CNRVon As Long, CNRNach As Long, Menge As Double, Optional MengeZuruecksetzen As Boolean, Optional OechsleZuruecksetzen As Boolean, Optional StatusEntleert As Boolean) - -Dim db1 As Database -Dim rsvon As Recordset -Dim rsnach As Recordset -Dim rsh As Recordset -Dim rsb As Recordset - -Set db1 = CurrentDb -Set rsvon = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRVon)) -Set rsnach = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRNach)) -Set rsh = db1.OpenRecordset("SELECT * FROM TChargenHierarchie WHERE CNR_Parent=" + Format(CNRVon) + " AND CNR_Child=" + Format(CNRNach)) -Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsnach("BNR"))) - -'Anwendung des Reduktionsfaktors -Menge = Menge * rsb("Reduktionsfaktor") - -'Überprüfe Überschreitung des Füllstandes der Zielcharge -If rsb("MaxMenge") < rsnach("Menge") + Menge Then - If MsgBox("Die angegebene Menge würde die maximal mögliche Füllmenge des Behälters überschreiten. Maximal sind " + Format(rsb("MaxMenge") - rsnach("Menge")) + " möglich. Wollen Sie trotzdem die Umfüllung vornehmen?", vbYesNo) = vbNo Then - rsvon.Close - rsnach.Close - rsh.Close - rsb.Close - Exit Sub - End If -End If - - -'Update Hierarchie -If rsh.EOF Then - rsh.AddNew - rsh("CNR_Parent") = CNRVon - rsh("CNR_Child") = CNRNach -Else - rsh.Edit -End If - - If IsNull(rsh("Menge")) Then - rsh("Menge") = Menge - Else - rsh("Menge") = rsh("Menge") + Menge - End If - rsh.Update - -'Update Zielcharge -rsnach.Edit -If IsNull(rsnach("Menge")) Then - rsnach("Menge") = 0 -End If -If IsNull(rsnach("Oechsle")) Then - rsnach("Oechsle") = 0 -End If - - - -rsnach("Oechsle") = (rsnach("Menge") * rsnach("Oechsle") + Menge * rsvon("Oechsle") * rsb("Reduktionsfaktor")) / (rsnach("Menge") + Menge * rsb("Reduktionsfaktor")) -rsnach("Menge") = rsnach("Menge") + Menge * rsb("Reduktionsfaktor") -rsnach.Update - -'Update Ursprungscharge -rsvon.Edit -If StatusEntleert And rsvon("Menge") <= 0 Then - rsvon("CSNR") = 4 -End If -If MengeZuruecksetzen Then - rsvon("Menge") = rsvon("Menge") - Menge -End If -If OechsleZuruecksetzen Then - rsvon("Oechsle") = Null -End If -rsvon.Update - -rsvon.Close -rsnach.Close -rsh.Close -rsb.Close - -End Sub - -Function ChargeStandNachFuellung(LINR1 As Long) As Double - -Dim db1 As Database -Dim rsc As Recordset -Dim rsl As Recordset -Dim rsb As Recordset -Dim ueberfuellt As Double - -Set db1 = CurrentDb - -'1. Öffnen der Datensätze -Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1)) -If rsl.EOF Then - rsl.Close - 'MsgBox ("Lieferung nicht gefunden!") - Exit Function -End If - -Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(rsl("CNR"))) -If rsc.EOF Then - rsc.Close - 'MsgBox ("Charge nicht gefunden!") - Exit Function -End If - -Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsc("BNR"))) -If rsb.EOF Then - rsb.Close - 'MsgBox ("Behälter nicht gefunden!") - Exit Function -End If - -'2. Überprüfen, ob Charge im richtigen Status und Lieferung zugeordnet -'TODO -'Charge im Status 2? -'Lieferung ist diese Charge zugeordnet? -'Chargentyp=Maische? - -If IsNull(rsc("Menge")) Then - ueberfuellt = rsl("Gewicht") - rsb("MaxMenge") -Else - ueberfuellt = rsc("Menge") + rsl("Gewicht") - rsb("MaxMenge") -End If - ChargeStandNachFuellung = ueberfuellt - -rsc.Close -rsb.Close -rsl.Close - - -End Function - - -Sub ChargenZuLieferungenZuordnen(Lesejahr1 As Long, Optional ZNR1 As Long) - -Dim db1 As Database -Dim rsc As Recordset -Dim rsl As Recordset -Dim where1 As String - -Set db1 = CurrentDb - -If ZNR1 > 0 Then - where1 = " WHERE Year(Datum)=" + Format(Lesejahr1) + " AND ZNR=" + Format(ZNR1) -Else - where1 = " WHERE Year(Datum)=" + Format(Lesejahr1) -End If -where1 = where1 + " AND NOT SNR=Null and not QSNR=Null and not Datum=Null " -Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen " + where1) -While Not rsl.EOF - where1 = " WHERE SNR='" + Format(rsl("SNR")) + "' AND Befuellungsbeginn=DateValue('" + Format(rsl("Datum"), "dd.mm.yyyy") + "') " - where1 = where1 + " AND (QSNRVon<=" + Format(rsl("QSNR")) + " OR QSNRVon=Null) AND (QSNRBis>=" + Format(rsl("QSNR")) + " OR QSNRBis=Null)" - Set rsc = db1.OpenRecordset("SELECT * FROM TChargen " + where1) - If IsNull(rsl("CNR")) Then - If Not rsc.EOF Then - rsl.Edit - rsl("CNR") = rsc("CNR") - rsl("AufChargeVerbucht") = True - rsl.Update - End If - End If - rsl.MoveNext -Wend - -db1.Close - -End Sub - - -Sub ChargenLieferungenZuordnungÄndern(LINR1 As Long, CNRVon As Long, CNRNach As Long) - -Dim db1 As Database -Dim rsc_von As Recordset -Dim rsl As Recordset -Dim rsc_nach As Recordset - -Set db1 = CurrentDb - -'1. Öffnen der Datensätze -Set rsc_von = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRVon)) -If rsc_von.EOF Then - rsc_von.Close - MsgBox ("Charge nicht gefunden!") - Exit Sub -End If - -Set rsc_nach = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRNach)) -If rsc_nach.EOF Then - rsc_nach.Close - MsgBox ("Charge nicht gefunden!") - Exit Sub -End If - -Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1)) -If rsl.EOF Then - rsl.Close - MsgBox ("Lieferung nicht gefunden!") - Exit Sub -End If - - -ChargeBefuellungRueckgaengig CNRVon, LINR1 -ChargeBefuellen CNRNach, LINR1 - - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/MFlaechenbindungen.bas b/wgmaster/vba/MFlaechenbindungen.bas deleted file mode 100644 index 3a59ef6..0000000 --- a/wgmaster/vba/MFlaechenbindungen.bas +++ /dev/null @@ -1,89 +0,0 @@ -Option Compare Database -Option Explicit - - -Sub FlaechenbindungenBerechnen(Jahr1 As Long) - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim temptablename1 As String -Dim oldMGNR As Long -Dim countit As Boolean -Dim summe As Double -temptablename1 = "xTempFlaechenbindungen" - -Set db1 = CurrentDb - -Set db1 = CurrentDb -If TableExists(temptablename1) Then - db1.Execute ("DROP TABLE " + temptablename1) -End If -db1.Execute ("CREATE TABLE " + temptablename1 + " (MGNR LONG, Gesamtflaeche DOUBLE);") -Set rs1 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen ORDER BY MGNR") -Set rs2 = db1.OpenRecordset(temptablename1) -oldMGNR = -1 -While Not rs1.EOF - If oldMGNR <> rs1("MGNR") Then - If oldMGNR <> -1 Then - rs2("MGNR") = oldMGNR - rs2("Gesamtflaeche") = summe - rs2.Update - End If - rs2.AddNew - summe = 0 - End If - - countit = True - If IsNull(rs1("Von")) Then - Else - If rs1("Von") <= Jahr1 Then - Else - countit = False - End If - End If - - If IsNull(rs1("Bis")) Then - Else - If rs1("Bis") >= Jahr1 Then - Else - countit = False - End If - End If - - If IsNull(rs1("Flaeche")) Then - countit = False - End If - - If countit Then - summe = summe + rs1("Flaeche") - End If - oldMGNR = rs1("MGNR") - rs1.MoveNext -Wend -rs2.Update -rs1.Close -rs2.Close - -End Sub - - - -Function TableExists(table1) As Boolean - -Dim db1 As Database -Set db1 = CurrentDb -Dim x As TableDef - -For Each x In db1.TableDefs - If x.Name = table1 Then - TableExists = True - Exit Function - End If -Next x - - TableExists = False - -End Function - - diff --git a/wgmaster/vba/MMigration.bas b/wgmaster/vba/MMigration.bas deleted file mode 100644 index e3f424f..0000000 --- a/wgmaster/vba/MMigration.bas +++ /dev/null @@ -1,45 +0,0 @@ -Option Compare Database - - - -Sub bankdaten_migration() - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim MGNR As Long -Dim KontoNr As String -Dim BLZ As String -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("TMitglieder") - -db1.Execute ("UPDATE RTRN6730000000000001 Set Übernommen=False") -While Not rs1.EOF - MGNR = rs1("MGNR") - If Not IsNull(rs1("KontoNr")) And Not IsNull(rs1("BLZ")) Then - KontoNr = rs1("Kontonr") - KontoNr = Replace(KontoNr, ".", "") - KontoNr = Replace(KontoNr, "-", "") - KontoNr = Replace(KontoNr, " ", "") - BLZ = rs1("BLZ") - While Left(KontoNr, 1) = "0" - KontoNr = Mid(KontoNr, 2) - Wend - - Set rs2 = db1.OpenRecordset("SELECT * FROM RTRN6730000000000001 WHERE BLZ='" + BLZ + "' AND KontoNummer='" + KontoNr + "'") - If Not rs2.EOF Then - rs1.Edit - rs1("IBAN") = rs2("IBAN") - rs1("BIC") = rs2("BIC") - rs1.Update - rs2.Edit - rs2("Übernommen") = True - rs2.Update - End If - End If - rs1.MoveNext -Wend -rs1.Close - - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/MMisc.bas b/wgmaster/vba/MMisc.bas deleted file mode 100644 index 53d8cde..0000000 --- a/wgmaster/vba/MMisc.bas +++ /dev/null @@ -1,501 +0,0 @@ -Option Compare Database -Option Explicit - - -Sub test() - -SwitchToolbars (True) - -End Sub - -Function SwitchToolbars(onoff As Boolean) - -'For Runtime -Exit Function - -If (onoff) Then - -DoCmd.ShowToolbar "Menüleiste", acToolbarYes ' -DoCmd.ShowToolbar "Formularansicht", acToolbarYes -DoCmd.ShowToolbar "Datenbank", acToolbarYes -DoCmd.SetDisplayedCategories (True) -'ÄndernEigenschaft "StartupForm", dbText, "MHauptmenü" -ÄndernEigenschaft "StartupShowDBWindow", dbBoolean, True -ÄndernEigenschaft "StartupShowStatusBar", dbBoolean, True -ÄndernEigenschaft "AllowFullMenus", dbBoolean, True - -Else - -DoCmd.ShowToolbar "Menüleiste", acToolbarNo -DoCmd.ShowToolbar "Formularansicht", acToolbarNo -DoCmd.ShowToolbar "Datenbank", acToolbarNo -DoCmd.SetDisplayedCategories (False) -'ÄndernEigenschaft "StartupForm", dbText, "MHauptmenü" -ÄndernEigenschaft "StartupShowDBWindow", dbBoolean, False -ÄndernEigenschaft "StartupShowStatusBar", dbBoolean, False -ÄndernEigenschaft "AllowFullMenus", dbBoolean, False - - -End If - - -End Function - - -Function StartupValues() - -'ÄndernEigenschaft "StartupShowDBWindow", dbBoolean, False -'ÄndernEigenschaft "StartupShowStatusBar", dbBoolean, False - -End Function - -Function ÄndernEigenschaft(strEigenschaftenname As String, varEigenschaftentyp As Variant, varEigenschaftenwert As Variant) As Integer - Dim dbs As Database, prp As property - Const conPropNotFoundError = 3270 - - Set dbs = CurrentDb - On Error GoTo Ändern_Fehler - dbs.Properties(strEigenschaftenname) = varEigenschaftenwert - ÄndernEigenschaft = True - -Ändern_Ende: - Exit Function - -Ändern_Fehler: - -If Err = conPropNotFoundError Then ' Eigenschaft nicht gefunden. - Set prp = dbs.CreateProperty(strEigenschaftenname, _ - varEigenschaftentyp, varEigenschaftenwert) - dbs.Properties.Append prp - Resume Next - Else - ' Unbekannter Fehler. - ÄndernEigenschaft = False - Resume Ändern_Ende - End If -End Function - - -Function GetLocalParameter(Name1 As String) As Variant - -GetLocalParameter = DFirst("[Wert]", "lParameter", "[Bezeichnung]='" + UCase(Name1) + "'") - -End Function - - -Function GetParameter(Name1 As String) As Variant - -GetParameter = DFirst("[Wert]", "TParameter", "[Bezeichnung]='" + UCase(Name1) + "'") - -End Function - -Sub SetParameter(Name1 As String, value1 As String) - -Dim db1 As Database -Dim rs1 As Recordset -Dim found As Boolean - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM TParameter;") - -found = False -rs1.MoveFirst -While (Not rs1.EOF) - If (UCase(rs1!Bezeichnung) = UCase(Name1)) Then found = True - rs1.MoveNext -Wend -rs1.Close - -Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM TParameter;") - -If found = True Then - rs1.MoveFirst - While (UCase(rs1!Bezeichnung) <> UCase(Name1)) - rs1.MoveNext - Wend - rs1.Edit - rs1!Wert = value1 - rs1.Update -Else: - rs1.AddNew - rs1!Bezeichnung = Name1 - rs1!Wert = value1 - rs1.Update -End If - -rs1.Close - - -End Sub - - -Sub SetLocalParameter(Name1 As String, value1 As String) - -Dim db1 As Database -Dim rs1 As Recordset -Dim found As Boolean - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM lParameter;") - -found = False -rs1.MoveFirst -While (Not rs1.EOF) - If (UCase(rs1!Bezeichnung) = UCase(Name1)) Then found = True - rs1.MoveNext -Wend -rs1.Close - -Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM lParameter;") - -If found = True Then - rs1.MoveFirst - While (UCase(rs1!Bezeichnung) <> UCase(Name1)) - rs1.MoveNext - Wend - rs1.Edit - rs1!Wert = value1 - rs1.Update -Else: - rs1.AddNew - rs1!Bezeichnung = Name1 - rs1!Wert = value1 - rs1.Update -End If - -rs1.Close - - -End Sub - - - - -Function Qualitätsstufe(Oechsle) As Variant - -If IsNull(Oechsle) Then - Qualitätsstufe = Null -Else - - Dim db1 As Database - Dim rs1 As Recordset - - Set db1 = CurrentDb - - Qualitätsstufe = "" - Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Von,Bis FROM TQualitaetsstufen;") - - rs1.MoveFirst - - While Not rs1.EOF - If Oechsle >= rs1!Von And Oechsle <= rs1!Bis Then - Qualitätsstufe = rs1!Bezeichnung - End If - rs1.MoveNext - Wend - rs1.Close - -End If - -End Function - -Function QSNR(Oechsle As Long) As Long - -If IsNull(Oechsle) Then - QSNR = Null -Else - - Dim db1 As Database - Dim rs1 As Recordset - - Set db1 = CurrentDb - - QSNR = Null - Set rs1 = db1.OpenRecordset("SELECT QSNR,Von,Bis FROM TQualitaetsstufen;") - - rs1.MoveFirst - - While Not rs1.EOF - If Oechsle >= rs1!Von And Oechsle <= rs1!Bis Then - QSNR = rs1!QSNR - End If - rs1.MoveNext - Wend - rs1.Close -End If - -End Function - -Function Fileexist(filename As String) As Boolean - -On Error GoTo NoFile - -If FileSystem.GetAttr(filename) >= 0 Then - Fileexist = True -Else - Fileexist = False -End If - -Exit Function - -NoFile: - Fileexist = False - Exit Function - -End Function - - -Function GetAppPath() As String - -Dim db1 As Database -Set db1 = CurrentDb - -'GetAppPath = Mid(db1.Name, 1, Len(db1.Name) - Len("WGMASTER.ACCDB")) -GetAppPath = Mid(db1.Name, 1, Len(db1.Name) - Len("WGMASTER2010.ACCDB")) - - -End Function - -Function GetDataPath() As String - -Dim datapath As String -datapath = DFirst("Data", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten)) -GetDataPath = datapath - -End Function - -Function GetPathWithoutFilename(fullpath As String) As String - -Dim str1 As String - -str1 = fullpath - -While Len(str1) > 0 And Mid(str1, Len(str1), 1) <> "\" - str1 = Mid(str1, 1, Len(str1) - 1) - If str1 = "" Then - GetPathWithoutFilename = "" - Exit Function - End If -Wend - -GetPathWithoutFilename = str1 - - -End Function - -Function GetLastMANR() As Long - -Dim db1 As Database -Dim rs1 As Recordset -Dim found As Boolean - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM Mandanten;") - -GetLastMANR = -1 -While (Not rs1.EOF) - If rs1!Last = True Then - GetLastMANR = rs1!MANR - End If - rs1.MoveNext -Wend -rs1.Close - -End Function - - -Sub SetLastMANR(manr1 As Long) - -Dim db1 As Database -Dim rs1 As Recordset -Dim found As Boolean - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM Mandanten;") - -found = False -While (Not rs1.EOF) - - If rs1!Last = True Then - rs1.Edit - rs1!Last = False - rs1.Update - End If - If rs1!MANR = manr1 Then - rs1.Edit - rs1!Last = True - rs1.Update - End If - rs1.MoveNext -Wend -rs1.Close - -End Sub - - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function - - - -Public Function GetAbschlägeAsString(LINR1 As Long) As String - Const separator = " / " - Const separator_length = 3 - Dim db1 As Database - Dim rs1 As Recordset - Dim resultString As String - Set db1 = CurrentDb - - Set rs1 = db1.OpenRecordset("SELECT TAbschlaege.* FROM (TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR) INNER JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE TLieferungen.LINR=" + Format(LINR1)) - - resultString = "" - While Not rs1.EOF - resultString = resultString + separator + rs1!Bezeichnung - rs1.MoveNext - Wend - rs1.Close - If resultString <> "" Then resultString = Mid(resultString, 1 + separator_length) - - GetAbschlägeAsString = resultString - -End Function - - -Public Function GetSNRAndSANRFromInput(SNRInput As String, SNR As String, SANR As String) As Boolean -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TSortenAttributeEingabe WHERE SNREingabe='" + SNRInput + "'") -If Not rs1.EOF Then - SNR = rs1("SNR") - SANR = rs1("SANR") - GetSNRAndSANRFromInput = True -Else - GetSNRAndSANRFromInput = False -End If -rs1.Close - -End Function - -Public Function GetGebietGLNR(SNR As String, QSNR As Long, GLNR As Long) As Long -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR + "' AND MinQSNR<=" + Format(QSNR) + " AND GLNR=" + Format(GLNR)) -If rs1.EOF Then - rs1.Close - 'Standardgebiet nehmen - Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR)) -End If -GetGebietGLNR = rs1("WBGNR") -rs1.Close - -End Function - -Public Function GetGebiet(SNR As String, QSNR As Long, GLNR As Long) As String -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR + "' AND MinQSNR<=" + Format(QSNR) + " AND GLNR=" + Format(GLNR)) -If rs1.EOF Then - rs1.Close - 'Standardgebiet nehmen - Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR)) -End If -GetGebiet = DFirst("Bezeichnung", "TGebiete", "WBGNR=" + Format(rs1("WBGNR"))) -rs1.Close - -End Function - - -Public Function GetHerkunft(SNR1 As String, QSNR1 As Long, GNR1 As Long) As String -Dim db1 As Database -Dim rs1 As Recordset -Dim WBGNR1 As Long -Dim RGNR1 As Long -Dim GLNR1 As Long - -GLNR1 = DFirst("GLNR", "TGemeinden", "GNR=" + Format(GNR1)) -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR1 + "' AND MinQSNR<=" + Format(QSNR1) + " AND GLNR=" + Format(GLNR1)) -If Not rs1.EOF Then - 'Spezialeintrag für diese Sorte und Qualität existiert - WBGNR1 = rs1("WBGNR") -Else - rs1.Close - 'Standardgebiet nehmen - Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR1)) - WBGNR1 = rs1("WBGNR") -End If -rs1.Close -RGNR1 = DFirst("RGNR", "TGebiete", "WBGNR=" + Format(WBGNR1)) - -If Not IsNull(DFirst("Herkunftsbezeichnung", "TQualitaetsstufen", "QSNR=" + Format(QSNR1))) Then - Select Case DFirst("Herkunftsbezeichnung", "TQualitaetsstufen", "QSNR=" + Format(QSNR1)) - Case "Land": GetHerkunft = "Österreich" - Case "Region": GetHerkunft = DFirst("Bezeichnung", "TRegionen", "RGNR=" + Format(RGNR1)) - Case "Gebiet": GetHerkunft = DFirst("Bezeichnung", "TGebiete", "WBGNR=" + Format(WBGNR1)) - Case "Grosslage": GetHerkunft = DFirst("Bezeichnung", "TGrosslagen", "GLNR=" + Format(GLNR1)) - Case "Gemeinde": GetHerkunft = DFirst("Bezeichnung", "TGemeinden", "GNR=" + Format(GNR1)) - End Select -Else - GetHerkunft = DFirst("Bezeichnung", "TRegionen", "RGNR=" + Format(RGNR1)) -End If - - -End Function -Public Function GetHerkunftBKI(SNR1 As String, QSNR1 As Long, GNR1 As Long) As String -Dim db1 As Database -Dim rs1 As Recordset -Dim WBGNR1 As Long -Dim RGNR1 As Long -Dim GLNR1 As Long - -GLNR1 = DFirst("GLNR", "TGemeinden", "GNR=" + Format(GNR1)) -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR1 + "' AND MinQSNR<=" + Format(QSNR1) + " AND GLNR=" + Format(GLNR1)) -If Not rs1.EOF Then - 'Spezialeintrag für diese Sorte und Qualität existiert - WBGNR1 = rs1("WBGNR") -Else - rs1.Close - 'Standardgebiet nehmen - Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR1)) - WBGNR1 = rs1("WBGNR") -End If -rs1.Close -RGNR1 = DFirst("RGNR", "TGebiete", "WBGNR=" + Format(WBGNR1)) - -If QSNR1 < 3 Then - GetHerkunftBKI = DFirst("Herkunftsbezeichnung", "TQualitaetsstufen", "QSNR=" + Format(QSNR1)) -Else - GetHerkunftBKI = DFirst("BKIKuerzel", "TGebiete", "WBGNR=" + Format(WBGNR1)) -End If - -End Function - - - - - diff --git a/wgmaster/vba/MProperties.bas b/wgmaster/vba/MProperties.bas deleted file mode 100644 index 51898ed..0000000 --- a/wgmaster/vba/MProperties.bas +++ /dev/null @@ -1,398 +0,0 @@ -Option Compare Database -Option Explicit - -Function SetDataPath() - -'SetLinkTablePath "", GetParameter("DATAPATH") + "WGDATEN.ACCDB" -'SetLinkTablePath "", "D:\PROJEKT\CHRIS\WGMASTER\WGDATEN.ACCDB" - -End Function - - -Function SetFormProperty(FormName As String, PropertyName As String, PropertyValue As Variant) -'Set Form Property, if Formname="" then set Property of all Forms - -If FormName = "" Or IsNull(FormName) Then - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Forms" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenForm doc1.Name, acDesign - On Error Resume Next - Forms(doc1.Name).Properties(PropertyName) = PropertyValue - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenForm FormName, acDesign - Forms(FormName).Properties(PropertyName) = PropertyValue - DoCmd.Save - DoCmd.Close -End If - -End Function - -Function GetFormProperty(FormName As String, PropertyName As String) As Variant -'Read Form Property - -DoCmd.OpenForm FormName, acDesign -GetFormProperty = Forms(FormName).Properties(PropertyName) -DoCmd.Close - -End Function - -Function SetFormControlProperty(FormName As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Integer - -If FormName = "" Or IsNull(FormName) Then - - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Forms" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenForm doc1.Name, acDesign - 'Search all Sections for desired Control - For i = 0 To 4 - On Error Resume Next - Set sec1 = Forms(doc1.Name).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - 'Has the desired control this property ? - If Controltype = ctl1.Controltype Or Controltype = -1 Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenForm FormName, acDesign - For i = 0 To 4 - Set sec1 = Forms(FormName).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - -Function SetFormSectionProperty(FormName As String, SectionName As String, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given section in the given form to the given value -' If Formname="" then all forms -' If Sectionname="" then all sections - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Integer - -If FormName = "" Or IsNull(FormName) Then - - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Forms" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenForm doc1.Name, acDesign - 'Search all Sections for desired Control - For i = 0 To 4 - On Error Resume Next - Set sec1 = Forms(doc1.Name).Section(i) - If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then - sec1.Properties(PropertyName) = PropertyValue - End If - Next i - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenForm FormName, acDesign - For i = 0 To 4 - Set sec1 = Forms(FormName).Section(i) - If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then - On Error Resume Next - sec1.Properties(PropertyName) = PropertyValue - End If - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - -Function GetFormControlProperty(FormName As String, ControlName As String, PropertyName As String) As Variant - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Integer - -'Search all Sections for desired Control - -DoCmd.OpenForm FormName, acDesign -For i = 0 To 4 - Set sec1 = Forms(FormName).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Then - GetFormControlProperty = ctl1.Properties(PropertyName) - i = 9 - Exit For - End If - Next ctl1 -Next i -DoCmd.Close - -End Function - - -Function SetReportProperty(reportname As String, PropertyName As String, PropertyValue As Variant) -'Set Report Property, if Report Name="" then all Reports - -If reportname = "" Or IsNull(reportname) Then - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenReport doc1.Name, acDesign - On Error Resume Next - Reports(doc1.Name).Properties(PropertyName) = PropertyValue - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 -Else - DoCmd.OpenReport reportname, acViewDesign - Reports(reportname).Properties(PropertyName) = PropertyValue - DoCmd.Save - DoCmd.Close -End If - -End Function - - -Function GetReportProperty(reportname As String, PropertyName As String) As Variant -'Read Form Property - -DoCmd.OpenReport reportname, acViewDesign -GetReportProperty = Reports(reportname).Properties(PropertyName) -DoCmd.Close - -End Function - -Function SetReportControlProperty(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Integer - -If reportname = "" Or IsNull(reportname) Then -'All Reports - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenReport doc1.Name, acViewDesign - 'Search all Sections for desired Control - For i = 0 To 8 - Set sec1 = Reports(doc1.Name).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - If Controltype = ctl1.Controltype Or Controltype = -1 Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenReport reportname, acViewDesign - For i = 0 To 8 - Set sec1 = Reports(reportname).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - -Function GetReportControlProperty(reportname As String, ControlName As String, PropertyName As String) As Variant - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Integer - -'Search all Sections for desired Control - -DoCmd.OpenReport reportname, acDesign -For i = 0 To 4 - Set sec1 = Reports(reportname).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Then - On Error Resume Next - GetReportControlProperty = ctl1.Properties(PropertyName) - i = 9 - Exit For - End If - Next ctl1 -Next i -DoCmd.Close - -End Function - -Function SetReportSectionProperty(reportname As String, SectionName As String, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Integer - -If reportname = "" Or IsNull(reportname) Then -'All Reports - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenReport doc1.Name, acViewDesign - 'Search all Sections for desired Control - For i = 0 To 8 - On Error Resume Next - Set sec1 = Reports(doc1.Name).Section(i) - If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then - On Error Resume Next - sec1.Properties(PropertyName) = PropertyValue - End If - Next i - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenReport reportname, acViewDesign - For i = 0 To 8 - Set sec1 = Reports(reportname).Section(i) - If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then - On Error Resume Next - sec1.Properties(PropertyName) = PropertyValue - End If - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - - -Function SetLinkTablePath(TableName As String, path1 As String) -'Set Table Property, if Tablename="" then set Property of all Tables - Dim db1 As Database - Dim tdf1 As TableDef - Set db1 = CurrentDb - - For Each tdf1 In db1.TableDefs - If TableName = tdf1.Name Or TableName = "" Or IsNull(TableName) Then - If (Left(tdf1.Name, 1) = "T" And TableName = "") Or TableName <> "" Then - tdf1.connect = ";DATABASE=" + path1 - On Error Resume Next - tdf1.RefreshLink - End If - End If - Next tdf1 - -End Function - - -' Example for easy usage : set form backgroundcolors - -Function SetBackGroundColor_AllForms(r As Long, g As Long, b As Long) - -SetFormSectionProperty "", "", "Backcolor", RGB(r, g, b) -'SetFormControlProperty "", "", -1, "Backcolor", RGB(r, g, b) -'SetFormControlProperty "", "", acTextBox, "Backcolor", RGB(255, 255, 255) -'SetFormControlProperty "", "", acComboBox, "Backcolor", RGB(255, 255, 255) -'SetFormControlProperty "", "", acListBox, "Backcolor", RGB(255, 255, 255) - -End Function - -Sub test() - -'SetBackGroundColor_AllForms &HEE, &HFF, &HEE -'SetFormControlProperty "", "", acTextBox, "FontSize", 9 -SetFormControlProperty "", "", acComboBox, "FontSize", 9 - -End Sub - - - -Function SetDefaultDataPath() - - - SetLinkTablePath "", GetAppPath + "WGLEER.ACCDB" - SetLinkTablePath "Mandanten", GetAppPath + "WGMANDNT.ACCDB" - -End Function - diff --git a/wgmaster/vba/MTanksanlegen.bas b/wgmaster/vba/MTanksanlegen.bas deleted file mode 100644 index ed4b0c0..0000000 --- a/wgmaster/vba/MTanksanlegen.bas +++ /dev/null @@ -1,407 +0,0 @@ -Option Compare Database -Option Explicit - -Sub TanksRoeschitzAnlegen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim i As Integer - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("TBehaelter") - -For i = 1 To 14 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 99000 - If i = 14 Then - rs1("MaxMenge") = 72600 - End If - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 3 - rs1.Update -Next i - -For i = 15 To 16 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 600000 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 2 - rs1.Update -Next i - - -For i = 17 To 22 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 15000 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 6 - rs1.Update -Next i - -For i = 23 To 38 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 30000 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 6 - If i = 35 Then - rs1("BSNR") = 2 - End If - rs1.Update -Next i - - -For i = 39 To 39 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 5000 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 6 - rs1.Update -Next i - -For i = 40 To 42 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 7000 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 6 - rs1.Update -Next i - -For i = 43 To 50 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 3000 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 6 - rs1.Update -Next i - -For i = 51 To 53 - rs1.AddNew - rs1("Kurzbezeichnung") = "T" + Format(i) - rs1("Bezeichnung") = "Tank " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 1500 - rs1("Reduktionsfaktor") = 1 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 6 - rs1.Update -Next i - -For i = 9 To 23 - rs1.AddNew - rs1("Kurzbezeichnung") = "Z" + Format(i) - rs1("Bezeichnung") = "Zisterne " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 25000 - rs1("Reduktionsfaktor") = 1 - rs1("BevorzugterSortenTyp") = "Rot" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 4 - rs1.Update -Next i - -For i = 1 To 3 - rs1.AddNew - rs1("Kurzbezeichnung") = "F" + Format(i) - rs1("Bezeichnung") = "Fass " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 9000 - rs1("Reduktionsfaktor") = 1 - rs1("BevorzugterSortenTyp") = "Rot" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 5 - rs1.Update -Next i - - - - -rs1.Close - - -End Sub - -Sub PositionenTanksRoeschitz() - -Dim db1 As Database -Dim rs1 As Recordset -Dim i As Integer - -Dim offset_x As Long -Dim offset_y As Long -Dim raster_x As Long -Dim raster_y As Long -Dim max_x As Long -Dim current_x As Long -Dim current_y As Long - -offset_x = 100 -offset_y = 550 -raster_x = 2000 -raster_y = 2000 -max_x = 14000 -Set db1 = CurrentDb -For i = 1 To 7 -Set rs1 = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BSNR=" + Format(i) + " order by BNR") -current_x = offset_x -current_y = offset_y -While Not rs1.EOF - rs1.Edit - rs1("Pos_X") = current_x - rs1("Pos_Y") = current_y - rs1.Update - current_x = current_x + raster_x - If current_x > max_x Then - current_x = offset_x - current_y = current_y + raster_x - End If - rs1.MoveNext -Wend -rs1.Close -Next i - - - - -End Sub - - -Sub TanksWinzerkellerAnlegen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim i As Integer - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("TBehaelter") - -For i = 1 To 12 - rs1.AddNew - rs1("Kurzbezeichnung") = "MB" + Format(i) - rs1("Bezeichnung") = "Weißwein Maischebehälter " + Format(i) - rs1("BTNR") = 2 - rs1("MaxMenge") = 12000 - rs1("Reduktionsfaktor") = 1 - rs1("BevorzugterSortenTyp") = "Weiß" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "kg" - rs1("BSNR") = 1 - rs1.Update -Next i - -For i = 1 To 5 - rs1.AddNew - rs1("Kurzbezeichnung") = "RT" + Format(i) - rs1("Bezeichnung") = "Rührtanks Rotwein " + Format(i) - rs1("BTNR") = 3 - rs1("MaxMenge") = 18000 - If i > 2 Then - rs1("MaxMenge") = 30000 - End If - rs1("Reduktionsfaktor") = 1 - rs1("BevorzugterSortenTyp") = "Rot" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "kg" - rs1("BSNR") = 1 - rs1.Update -Next i - -For i = 1 To 4 - rs1.AddNew - rs1("Kurzbezeichnung") = "P" + Format(i) - rs1("Bezeichnung") = "Presse " + Format(i) - rs1("BTNR") = 1 - rs1("MaxMenge") = 30000 - rs1("Reduktionsfaktor") = 0.8 - 'rs1("BevorzugterSortenTyp") = "" - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "kg" - rs1("BSNR") = 1 - rs1.Update -Next i - -For i = 1 To 5 - rs1.AddNew - rs1("Kurzbezeichnung") = "W" + Format(i) - rs1("Bezeichnung") = "Weißwein-Mosttank " + Format(i) - rs1("BTNR") = 4 - rs1("MaxMenge") = 32000 - If i = 1 Or i = 4 Then rs1("MaxMenge") = 50000 - rs1("BevorzugterSortenTyp") = "Weiß" - rs1("Reduktionsfaktor") = 1 - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 2 - rs1.Update -Next i - -For i = 6 To 9 - rs1.AddNew - rs1("Kurzbezeichnung") = "R" + Format(i) - rs1("Bezeichnung") = "Rotwein-Mosttank " + Format(i) - rs1("BTNR") = 4 - rs1("MaxMenge") = 26000 - If i = 9 Then rs1("MaxMenge") = 50000 - rs1("BevorzugterSortenTyp") = "Weiß" - rs1("Reduktionsfaktor") = 1 - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "l" - rs1("BSNR") = 2 - rs1.Update -Next i - - -For i = 1 To 3 - rs1.AddNew - rs1("Kurzbezeichnung") = "V" + Format(i) - rs1("Bezeichnung") = "Rotwein-Mosttank " + Format(i) - rs1("BTNR") = 6 - rs1("MaxMenge") = 12000 - rs1("BevorzugterSortenTyp") = "Rot" - rs1("Reduktionsfaktor") = 1 - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "kg" - rs1("BSNR") = 1 - rs1.Update -Next i - -'Scheitermost - rs1.AddNew - rs1("Kurzbezeichnung") = "ST" + Format(10) - rs1("Bezeichnung") = "Scheitermosttank " + Format(10) - rs1("BTNR") = 4 - rs1("MaxMenge") = 32000 - rs1("BevorzugterSortenTyp") = "Weiß" - rs1("Reduktionsfaktor") = 1 - rs1("Pos_X") = 100 - rs1("Pos_Y") = 4100 - rs1("MengenEinheit") = "kg" - rs1("BSNR") = 1 - rs1.Update - - - -rs1.Close - - -End Sub - - - -Sub PositionenTanksWinzerkeller() - -Dim db1 As Database -Dim rs1 As Recordset -Dim i As Integer - -Dim offset_x As Long -Dim offset_y As Long -Dim raster_x As Long -Dim raster_y As Long -Dim max_x As Long -Dim current_x As Long -Dim current_y As Long -Dim x As String - -offset_x = 100 -offset_y = 550 -raster_x = 1700 -raster_y = 1900 -max_x = 14000 -Set db1 = CurrentDb -For i = 1 To 2 -Set rs1 = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BSNR=" + Format(i) + " order by BNR") -current_x = offset_x -current_y = offset_y -While Not rs1.EOF - rs1.Edit - rs1("Pos_X") = current_x - rs1("Pos_Y") = current_y - rs1.Update - current_x = current_x + raster_x - 'If MsgBox("Momentaner Behälter=" + Format(rs1("Kurzbezeichnung")) + ". Zeilenumbruch?", vbYesNo) = vbYes Then - ' current_x = offset_x - ' current_y = current_y + raster_x - 'End If - x = rs1("Kurzbezeichnung") - - If x = "MB6" Or x = "MB12" Or x = "RT5" Or x = "P4" Then - current_x = offset_x - current_y = current_y + raster_x - End If - - - If current_x > max_x Then - current_x = offset_x - current_y = current_y + raster_x - End If - rs1.MoveNext -Wend -rs1.Close -Next i - - - - -End Sub diff --git a/wgmaster/vba/MTcpSocket.bas b/wgmaster/vba/MTcpSocket.bas deleted file mode 100644 index 49b5acc..0000000 --- a/wgmaster/vba/MTcpSocket.bas +++ /dev/null @@ -1,215 +0,0 @@ -Option Compare Database - -' Fügen sie diesen Code in ein öffentliches Modul ein -Private Declare Function gethostbyname Lib "wsock32.dll" ( _ - ByVal Name As String) As Long -Private Declare Function socket Lib "wsock32.dll" ( _ - ByVal af As Long, _ - ByVal prototype As Long, _ - ByVal protocol As Long) As Long -Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long -Private Declare Function connect Lib "wsock32.dll" ( _ - ByVal s As Long, _ - Name As SOCKADDR, _ - ByVal namelen As Long) As Long -Private Declare Function send Lib "wsock32.dll" ( _ - ByVal s As Long, _ - buf As Any, _ - ByVal length As Long, _ - ByVal flags As Long) As Long -Private Declare Function recv Lib "wsock32.dll" ( _ - ByVal s As Long, _ - buf As Any, _ - ByVal length As Long, _ - ByVal flags As Long) As Long -Private Declare Function ioctlsocket Lib "wsock32.dll" ( _ - ByVal s As Long, _ - ByVal cmd As Long, _ - argp As Long) As Long -Private Declare Function inet_addr Lib "wsock32.dll" ( _ - ByVal cp As String) As Long -Private Declare Function htons Lib "wsock32.dll" ( _ - ByVal hostshort As Integer) As Integer -Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long -Private Declare Sub MoveMemory Lib "kernel32" _ - Alias "RtlMoveMemory" ( _ - Destination As Any, _ - Source As Any, _ - ByVal length As Long) - -Private Declare Function WSAStartup Lib "wsock32.dll" ( _ - ByVal wVersionRequested As Integer, _ - lpWSAData As WSAData) As Long -Private Declare Function WSACleanup Lib "wsock32.dll" () As Long - -Private Type HOSTENT - hname As Long - haliases As Long - haddrtype As Integer - hlength As Integer - haddrlist As Long -End Type - -Private Type SOCKADDR - sin_family As Integer - sin_port As Integer - sin_addr As Long - sin_zero As String * 8 -End Type - -Private Type WSAData - wVersion As Integer - wHighVersion As Integer - szDescription As String * 257 - szSystemStatus As String * 129 - iMaxSockets As Long - iMaxUdpDg As Long - lpVendorInfo As Long -End Type - - - -' eine der HOSTENT-haddrtype-Konstanten -Private Const AF_INET = 2 ' Internet Protokoll (UDP/IP oder TCP/IP). - -' socket prototype-Konstanten -Private Const SOCK_STREAM = 1 ' 2-wege Stream. Bei AF_INET ist es das -' TCP/IP Protokoll -Private Const SOCK_DGRAM = 2 ' Datagramm Basierende verbindung. Bei AF_INET -' ist es das UDP Protokoll - -' recv flags-Konstanten -Private Const MSG_PEEK = &H2 ' Daten aus dem Puffer lesen, aber nicht aus -' dem Puffer entfernen - -' ioctlsocket cmd-Konstanten -Private Const FIONBIO = &H8004667E ' Setzen ob die Funktion bei der nächsten -' Datenanfrage zurückkehren soll - -Dim hSock As Long - - -' IP-Adresse einer Internetadresse ermitteln -Public Function GetIP(ByVal HostName As String) As String - Dim pHost As Long, HostInfo As HOSTENT - Dim pIP As Long, IPArray(3) As Byte - - ' Informationen des Host ermitteln - pHost = gethostbyname(HostName) - If pHost = 0 Then Exit Function - - ' HOSTENT-Struktur kopieren - MoveMemory HostInfo, ByVal pHost, Len(HostInfo) - - ' Pointer der 1ten Ip-Adresse ermitteln - ReDim IpAddress(HostInfo.hlength - 1) - MoveMemory pIP, ByVal HostInfo.haddrlist, 4 - MoveMemory IPArray(0), ByVal pIP, 4 - - GetIP = IPArray(0) & "." & IPArray(1) & "." & IPArray(2) & "." & IPArray(3) -End Function - -' Mit einem Server verbinden -Public Function ConnectToServer(ByVal ServerIP As String, ByVal ServerPort _ -As Long) As Long - Dim Retval As Long, ServerAddr As SOCKADDR - - ' Socket erstellen - hSock = socket(AF_INET, SOCK_STREAM, 0&) - If hSock = -1 Then - ConnectToServer = -1 - Exit Function - End If - - ' mit dem Server verbinden - With ServerAddr - .sin_addr = inet_addr(ServerIP) - .sin_port = htons(ServerPort) - .sin_family = AF_INET - End With - Retval = connect(hSock, ServerAddr, Len(ServerAddr)) - If Retval < 0 Then - MsgBox ("Connection Error:" + Retval) - Call closesocket(hSock) - ConnectToServer = -1 - Exit Function - End If - - ' Rückkehren der Funktion nach dem Abfragen von ankommenden Daten erzwingen - Retval = ioctlsocket(hSock, FIONBIO, 1&) - - ' Socket-ID zurückgeben - ConnectToServer = hSock -End Function - -' Sock/Verbindung schließen -Public Function Disconnect(ByRef Sock As Long) - Call closesocket(hSock) - Sock = 0 -End Function - -' Daten senden -Public Function SendData(ByVal Data As String) As Long - SendData = send(hSock, ByVal Data, Len(Data), 0&) -End Function - -' Sind Daten angekommen ? -Public Function DataComeIn() As Long - Dim Tmpstr As String * 1 - - DataComeIn = recv(hSock, ByVal Tmpstr, Len(Tmpstr), MSG_PEEK) - If DataComeIn = -1 Then - DataComeIn = WSAGetLastError() - End If -End Function - -' Daten ermitteln -Public Function GetData() As String - Dim Tmpstr As String * 4096, Retval As Long - - Retval = recv(hSock, ByVal Tmpstr, Len(Tmpstr), 0&) - GetData = Left$(Tmpstr, Retval) -End Function - -' Fügen Sie diesen Code in eine Form mit einem Command-Button und einem -' Textfeld ein - - -Public Function StartWinSocket() As Long - - Dim Retval As Long, WSD As WSAData - - Retval = WSAStartup(&H202, WSD) - If Retval < 0 Then - StartWinSocket = -1 - End If - - StartWinSocket = 0 - -End Function - - -Public Sub EndWinSocket() - - Call Disconnect(hSock) - Call WSACleanup - -End Sub - - -Public Function ReceiveString(length) As String - -Dim resultString As String - -While Len(resultString) < length - - While DataComeIn() = 0 - DoEvents - Wend - - resultString = resultString + GetData() - -Wend -ReceiveString = resultString - -End Function diff --git a/wgmaster/vba/MWaage.bas b/wgmaster/vba/MWaage.bas deleted file mode 100644 index bd372dc..0000000 --- a/wgmaster/vba/MWaage.bas +++ /dev/null @@ -1,995 +0,0 @@ -Option Compare Database -Option Explicit - -Dim tcpConnectionKeepAlive As Boolean -Dim tcpConnectionOpen As Boolean - -Sub WiegenInitialisieren() - -tcpConnectionOpen = False -tcpConnectionKeepAlive = True - -End Sub - -Sub WiegenBeenden() - -If tcpConnectionOpen = True Then - EndWinSocket - tcpConnectionOpen = False -End If - - -End Sub - -Function Wiegen(Optional Datum As Date, Optional zeit As Date, Optional Gewicht As Long, Optional Waagentext As String, Optional KeineIdentNummernErhöhung As Boolean) As Long - -Dim waagentyp1 - -waagentyp1 = GetParameter("WAAGENTYP") - -Wiegen = -1 - -If waagentyp1 = "TOLEDO" Then - Wiegen = WiegenToledo -End If - -If waagentyp1 = "GASSNER" Then - Wiegen = WiegenGassner(Datum, zeit, Gewicht, Waagentext) -End If - -If waagentyp1 = "SCHEMBER" Then - Wiegen = WiegenSchember -End If - -If waagentyp1 = "SYSTEC" Then - Wiegen = WiegenSystec -End If - -If waagentyp1 = "IT3000" Then - Wiegen = WiegenIt3000(Datum, zeit, Gewicht) -End If - -If waagentyp1 = "IT3000A" Then - Wiegen = WiegenIt3000a(Datum, zeit, Gewicht, Waagentext, KeineIdentNummernErhöhung) -End If - -If waagentyp1 = "L320" Then - Wiegen = L320(Datum, zeit, Gewicht, Waagentext) -End If - -If waagentyp1 = "L246" Then - Wiegen = L246(Datum, zeit, Gewicht, Waagentext, KeineIdentNummernErhöhung) -End If - - - -End Function - - -Function WiegenToledo() As Long -' Wolkersdorf, Haugsdorf - -Dim buff(0 To 11) As Integer -Dim i, c As Integer -Dim str1 As String - -' Send command "netto weight": "CP" -Forms!FÜbernahme.send (Asc("C")) -Forms!FÜbernahme.TheEvent = 0 -While Forms!FÜbernahme.TheEvent < 1 - DoEvents -Wend -Forms!FÜbernahme!XComm.InBufferCount = 0 -Forms!FÜbernahme.send (Asc("P")) - -' Read whole response word: 12 Bytes -While i < 12 And c <> -1 - c = Forms!FÜbernahme.Receive() - buff(i) = c - i = i + 1 -Wend - -If c = -1 Then - WiegenToledo = -1 - Exit Function -Else -'Number of read bytes OK - - 'Check if format is OK - - 'First byte: 02 - If buff(0) <> 2 Then - WiegenToledo = -2 - Exit Function - End If - 'Bytes 9 and 10: 'kg' - If buff(8) <> Asc("k") Then - WiegenToledo = -3 - Exit Function - End If - If buff(9) <> Asc("g") Then - WiegenToledo = -3 - Exit Function - End If - 'Bytes 11 and 12: 0D 0A (CRLF) - If buff(10) <> &HD Then - WiegenToledo = -4 - Exit Function - End If - If buff(11) <> &HA Then - WiegenToledo = -5 - Exit Function - End If - - 'Convert weight to long value - str1 = "" - For i = 1 To 7 - str1 = str1 + Chr(buff(i)) - Next i - c = CLng(str1) - - WiegenToledo = c - -End If - - -End Function - - - -Function WiegenGassner(Datum As Variant, zeit As Variant, Gewicht As Long, Waagentext As Variant) As Long -'im Moment nirgends - -Dim buff(0 To 99) As Integer -Dim i, c As Integer -Dim str1 As String -Dim str2 As String -Dim waagennummer As Long -Dim speichernummer As Long - -' Send command "ENQ": 05h -Forms!FÜbernahme!XComm.InBufferCount = 0 -Forms!FÜbernahme.send (&H5) -Forms!FÜbernahme.TheEvent = 0 - -' Read whole response word: 25 Bytes -While i < 47 And c <> -1 - c = Forms!FÜbernahme.Receive() - buff(i) = c - i = i + 1 -Wend - -'str1 = "" -'For i = 0 To 46 -' str1 = str1 + Hex(buff(i)) + " " -' str2 = str2 + Chr(buff(i)) -'Next i -'MsgBox (str1 + Chr(10) + Chr(13) + str2) - -If c = -1 Then - WiegenGassner = -1 - Exit Function -Else -'Number of read bytes OK - - 'Check if format is OK - - 'First byte: 02 - If buff(0) <> 2 Then - WiegenGassner = -2 - Exit Function - End If - - 'Second byte: "E"/"S" (" "..OK, "E" for Error) - If buff(1) <> Asc(" ") Then - WiegenGassner = -3 - Exit Function - End If - - 'Third byte: "S"/"M" - If buff(2) <> Asc("S") Then - WiegenGassner = -4 - Exit Function - End If - - 'Convert weight to long value - str1 = "" - For i = 0 To 6 - str1 = str1 + Chr(buff(i + 17)) - Next i - c = CLng(str1) - Gewicht = c - WiegenGassner = c - - 'Convert weight to long value - str1 = "" - For i = 0 To 6 - str1 = str1 + Chr(buff(i + 17)) - Next i - c = CLng(str1) - Gewicht = c - WiegenGassner = c - - 'Convert Waagennummer - str1 = "" - For i = 0 To 1 - str1 = str1 + Chr(buff(i + 24)) - Next i - c = CLng(str1) - waagennummer = c - - 'Convert Speichernummer - str1 = "" - For i = 0 To 5 - str1 = str1 + Chr(buff(i + 26)) - Next i - c = CLng(str1) - speichernummer = c - - 'Convert Datum - str1 = "" - For i = 0 To 7 - str1 = str1 + Chr(buff(i + 32)) - Next i - If IsDate(Mid(str1, 7, 2) + "." + Mid(str1, 5, 2) + "." + Mid(str1, 1, 4)) Then - Datum = DateValue(Mid(str1, 7, 2) + "." + Mid(str1, 5, 2) + "." + Mid(str1, 1, 4)) - End If - - 'Convert Zeit - str1 = "" - For i = 0 To 5 - str1 = str1 + Chr(buff(i + 40)) - Next i - If IsDate(Mid(str1, 1, 2) + ":" + Mid(str1, 3, 2) + ":" + Mid(str1, 5, 2)) Then - zeit = TimeValue(Mid(str1, 1, 2) + ":" + Mid(str1, 3, 2) + ":" + Mid(str1, 5, 2)) - End If - Waagentext = "Waagennummer: " + Format(waagennummer) + " Speichernummer: " + Format(speichernummer) - -End If - - -End Function - -Function WiegenGassnerAlt() As Long -'im Moment nirgends - -Dim buff(0 To 24) As Integer -Dim i, c As Integer -Dim str1 As String - -' Send command "ENQ": 05h -Forms!FÜbernahme!XComm.InBufferCount = 0 -Forms!FÜbernahme.send (&H5) -Forms!FÜbernahme.TheEvent = 0 - -' Read whole response word: 25 Bytes -While i < 25 And c <> -1 - c = Forms!FÜbernahme.Receive() - buff(i) = c - i = i + 1 -Wend - -If c = -1 Then - WiegenGassnerAlt = -1 - Exit Function -Else -'Number of read bytes OK - - 'Check if format is OK - - 'First byte: 02 - If buff(0) <> 2 Then - WiegenGassnerAlt = -2 - Exit Function - End If - - 'Second byte: "E"/"S" (" "..OK, "E" for Error) - If buff(1) <> " " Then - WiegenGassnerAlt = -3 - Exit Function - End If - - 'Third byte: "S"/"M" - If buff(2) <> "S" Then - WiegenGassnerAlt = -4 - Exit Function - End If - - 'Byte 25 - 'If buff(24) <> &H3 Then - ' WiegenGassner = -5 - ' Exit Function - 'End If - - 'Convert weight to long value - str1 = "" - For i = 0 To 6 - str1 = str1 + Chr(buff(i + 17)) - Next i - c = CLng(str1) - - WiegenGassnerAlt = c - -End If - - -End Function - - - -Function WiegenSchember() As Long - -' Matzen - -Dim buff(0 To 24) As Integer -Dim i, c As Integer -Dim str1 As String - -' Send command "27,62" -Forms!FÜbernahme.send (27) -Forms!FÜbernahme.TheEvent = 0 -While Forms!FÜbernahme.TheEvent < 1 - DoEvents -Wend -Forms!FÜbernahme.XComm.InBufferCount = 0 -Forms!FÜbernahme.send (62) - -' Read whole response word: 12 Bytes -While i < 25 And c <> -1 - c = Forms!FÜbernahme.Receive() - buff(i) = c - i = i + 1 -Wend - -If c = -1 Then - WiegenSchember = -1 - Exit Function -Else -'Number of read bytes OK - - 'Check if format is OK - - 'First byte: 02 - If buff(0) <> 2 Then - WiegenSchember = -2 - Exit Function - End If - - 'Bytes 11 and 12: 0D 0A (CRLF) - If buff(24) <> 3 Then - WiegenSchember = -4 - Exit Function - End If - - 'Convert weight to long value - str1 = "" - For i = 16 To 19 - str1 = str1 + Chr(buff(i)) - Next i - str1 = str1 + "," - str1 = str1 + Chr(buff(20)) - c = CDbl(str1) - - - WiegenSchember = c - -End If - - -End Function - - -Function WiegenSystec() As Long - -' Matzen - -Dim buff(0 To 50) As Integer -Dim i, c As Integer -Dim str1 As String - - -Forms!FÜbernahme.XComm.InBufferCount = 0 - -'Wait for STX -Do - c = Forms!FÜbernahme.Receive() -Loop Until c = 2 -buff(0) = c - -i = 1 -While i < 17 And c <> -1 - c = Forms!FÜbernahme.Receive() - buff(i) = c - i = i + 1 -Wend - -If c = -1 Then - WiegenSystec = -1 - Exit Function -Else - -'Number of read bytes OK - -'Check if format is OK - - 'First byte: 02 - If buff(0) <> 2 Then - WiegenSystec = -2 - Exit Function - End If - - 'Convert weight to long value - str1 = "" - For i = 4 To 9 - str1 = str1 + Chr(buff(i)) - Next i - c = CDbl(str1) - - WiegenSystec = c - -End If - - -End Function - - -Function WiegenIt3000(Datum As Date, zeit As Date, Gewicht As Long) As Long -' Röschitz - -Dim c As Integer -Dim recordcount As Integer -Dim record(0 To 20) As String - -'Receive STX -While c <> 2 And c <> -1 - c = Forms!FÜbernahme.Receive() -Wend -If c = -1 Then - WiegenIt3000 = -1 - Forms!FÜbernahme.send (&H15) 'NAK - Exit Function -End If -'Receive Buffer and terminating ETX -recordcount = 0 -record(recordcount) = "" -While c <> -1 And c <> 3 'ETX - c = Forms!FÜbernahme.Receive() - If c = Asc(";") Or c = 3 Then - recordcount = recordcount + 1 - record(recordcount) = "" - Else - If c <> -1 Then - record(recordcount) = record(recordcount) + Chr(c) - End If - End If -Wend -If c = -1 Then - WiegenIt3000 = -2 - Forms!FÜbernahme.send (&H15) 'NAK - Exit Function -End If - -'interpret records -If recordcount < 4 Then - 'too less records - WiegenIt3000 = -3 - Forms!FÜbernahme.send (&H15) 'NAK - Exit Function -End If -'record(0) is waagennummer -Datum = DateValue(record(1)) -zeit = TimeValue(record(2)) -Gewicht = Val(record(3)) - -'send acknowledge -Forms!FÜbernahme.send (6) 'ACK - -Forms!FÜbernahme!XComm.InBufferCount = 0 - - -End Function - -Function WiegenIt3000a(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String, KeineIdentNummernErhöhung As Boolean) As Long -' Matzen, Wolkersdorf - -Dim c As Integer -Dim i As Integer -Dim Data As String -Dim record As String -Dim waagennummer As Long -Dim speichernummer As Long - -Forms!FÜbernahme.XComm.InBufferCount = 0 -Forms!FÜbernahme.TheEvent = 0 - -If KeineIdentNummernErhöhung = True Then -'Send command - Forms!FÜbernahme.send (Asc("<")) - Forms!FÜbernahme.send (Asc("R")) - Forms!FÜbernahme.send (Asc("M")) - Forms!FÜbernahme.send (Asc(">")) -Else -'Send command - Forms!FÜbernahme.send (Asc("<")) - Forms!FÜbernahme.send (Asc("R")) - Forms!FÜbernahme.send (Asc("N")) - Forms!FÜbernahme.send (Asc(">")) -End If - -'Receive record -i = 0 -Data = "" -While i < 64 And c <> -1 - c = Forms!FÜbernahme.Receive() - If c <> -1 Then - Data = Data + Chr(c) - End If - i = i + 1 -Wend - -'MsgBox (data) - -'skip < and > -Data = Mid(Data, 2, 62) - - -If c = -1 Then - WiegenIt3000a = -1 - Exit Function -End If - -'interpret data -'1. Fehlercode, Waagenstatus -record = Left(Data, 4) -Data = Mid(Data, 5) -If record <> "0000" Then - WiegenIt3000a = -2 - Exit Function -End If -'2. Date -record = Left(Data, 8) -Data = Mid(Data, 9) -If IsDate(record) Then - Datum = DateValue(record) -Else - WiegenIt3000a = -3 - Exit Function -End If -'2. Time -record = Left(Data, 5) -record = record + ":00" -Data = Mid(Data, 6) -If IsDate(record) Then - zeit = TimeValue(record) -Else - WiegenIt3000a = -4 - Exit Function -End If -'4. Identnr -record = Left(Data, 4) -Data = Mid(Data, 5) -speichernummer = Val(record) -'5. Waagennr -record = Left(Data, 1) -Data = Mid(Data, 2) -waagennummer = Val(record) -'6. Brutto -record = Left(Data, 8) -Data = Mid(Data, 9) -'7. Tara -record = Left(Data, 8) -Data = Mid(Data, 9) -'8. Netto -record = Left(Data, 8) -Data = Mid(Data, 9) -If IsNumeric(record) Then - Gewicht = Val(record) -Else - WiegenIt3000a = -5 - Exit Function -End If -'9. kg -record = Left(Data, 2) -Data = Mid(Data, 3) -If record <> "kg" Then - WiegenIt3000a = -6 - Exit Function -End If - -'rest wird nicht ausgewertet - -Waagentext = "Waagenr: " + Format(waagennummer) + " ID: " + Format(speichernummer) - -WiegenIt3000a = Gewicht - -End Function - -Sub testl320() - -Dim Datum As Date -Dim zeit As Date -Dim Gewicht As Long -Dim Waagentext As String -Dim chk As String -Dim Data As String - -Data = " 17.04.14 12:58 2 72kg" + Chr(10) - -Data = Mid(Data, 2) -Datum = CDate(Left(Data, 8)) -Data = Mid(Data, 10) -zeit = CDate(Left(Data, 5)) -Data = Mid(Data, 7) -Waagentext = Left(Data, 4) -Data = Mid(Data, 6) -Gewicht = CLng(Left(Data, 9)) -Data = Mid(Data, 11) -chk = Left(Data, 2) - -MsgBox (Datum) -MsgBox (zeit) -MsgBox (Gewicht) -MsgBox (Waagentext) - -End Sub - - -Function L320(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String) As Long - -Dim c As Long -Dim Data As String -Dim chk As String -Dim i As Integer -Dim str1 As String -'Receive record -str1 = "" - -Data = "" - -c = Forms!FÜbernahme.Receive() -str1 = Format(c) -'Forms!FÜbernahme!XComm.InBufferCount -If c = 32 Then - i = 1 - Data = Data + Chr(c) -Else - c = Forms!FÜbernahme.Receive() - str1 = str1 + "," + Format(c) - c = Forms!FÜbernahme.Receive() - str1 = str1 + "," + Format(c) - 'MsgBox (str1) - L320 = -9 - Exit Function -End If - -While i < 33 And c <> -1 - c = Forms!FÜbernahme.Receive() - If c <> -1 Then - Data = Data + Chr(c) - End If - str1 = str1 + "," + Format(c) - i = i + 1 -Wend - -'1: 0x20 -'2-9: Date 17.04.14 -'10 0x20 -'11-15: Time 12:58 -'16: 0x20 -'17-20: wiegenr -'21: 0x20 -'22-30: gewicht -'31-32: kg -'33: 0x0A -'MsgBox (str1 + ":" + Format(Len(data)) + ":" & data) -If Len(Data) >= 33 Then - Data = Mid(Data, 2) - Datum = CDate(Left(Data, 8)) - Data = Mid(Data, 10) - zeit = CDate(Left(Data, 5)) - Data = Mid(Data, 7) - Waagentext = Left(Data, 4) - Data = Mid(Data, 6) - Gewicht = CLng(Left(Data, 9)) - Data = Mid(Data, 10) - chk = Left(Data, 2) - If chk <> "kg" Then - 'MsgBox ("Fehler! Waagenrecord nicht korrekt") - L320 = -1 - Else - L320 = Gewicht - End If -Else - L320 = -9 -End If - - -End Function - - -Function L246(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String, KeineIdentNummernErhöhung As Boolean) As Long - -' 1. open tcp port -Dim host As String -Dim tcpport As Long -Dim result As Long - -If tcpConnectionOpen = False Then - host = GetParameter("WAAGEHOST") - tcpport = GetParameter("WAAGETCPPORT") - StartWinSocket - result = ConnectToServer(host, tcpport) - If result > 0 Then - tcpConnectionOpen = True - End If -End If - -If tcpConnectionOpen = True Then - ' 2. send command - If (KeineIdentNummernErhöhung) Then - SendData "" - Else - SendData "" - End If - - ' 3. receive data - Dim response As String - - response = ReceiveString(65) - - ' 4. parse message - 'MsgBox (response) - 'Dim fehlerS As String - Dim datumS As String - Dim zeitS As String - Dim identNrS As String - Dim nettoS As String - Dim waagennummerS As String - Dim fehlerS As String - - fehlerS = Mid(response, 2, 2) - datumS = Mid(response, 6, 8) - zeitS = Mid(response, 14, 5) - identNrS = Mid(response, 19, 4) - waagennummerS = Mid(response, 23, 1) - nettoS = Mid(response, 40, 8) - - - If fehlerS <> "00" Then - MsgBox "Fehlermeldung Waage", vbCritical - End If - - Datum = CDate(datumS) - zeit = CDate(zeitS) - Waagentext = "Waagenr: " + Format(waagennummerS) + " ID: " + Format(identNrS) - Gewicht = CLng(nettoS) - - 'MsgBox (datum) - 'MsgBox (zeit) - 'MsgBox (waagentext) - 'MsgBox (Gewicht) - - - ' 5. close port - If tcpConnectionKeepAlive = False Then - EndWinSocket - tcpConnectionOpen = False - End If -End If - - -End Function - -Function KippenL246(onoff As Boolean) - -Dim host As String -Dim tcpport As Long -Dim result As Long -If tcpConnectionOpen = False Then - host = GetParameter("WAAGEHOST") - tcpport = GetParameter("WAAGETCPPORT") - StartWinSocket - result = ConnectToServer(host, tcpport) - If result > 0 Then - tcpConnectionOpen = True - End If -End If - -If tcpConnectionOpen = True Then - ' 2. send command - If onoff Then - SendData "" - Else - SendData "" - End If - - ' 3. receive data - Dim response As String - - response = ReceiveString(5) - - ' 4. parse message - If Left(response, 4) <> "<00>" Then - MsgBox "Fehler beim Ansteuern des digitalen Ausganges", vbCritical - End If - - ' 5. close port - If tcpConnectionKeepAlive = False Then - EndWinSocket - tcpConnectionOpen = False - End If - -End If - - -End Function - - -Function FreigabeL246(onoff As Boolean) - -Dim host As String -Dim tcpport As Long -Dim result As Long - -If tcpConnectionOpen = False Then - host = GetParameter("WAAGEHOST") - tcpport = GetParameter("WAAGETCPPORT") - StartWinSocket - result = ConnectToServer(host, tcpport) - If result > 0 Then - tcpConnectionOpen = True - End If -End If - -If tcpConnectionOpen = True Then - ' 2. send command - If onoff Then - SendData "" - Else - SendData "" - End If - - ' 3. receive data - Dim response As String - - response = ReceiveString(5) - - ' 4. parse message - If Left(response, 4) <> "<00>" Then - MsgBox "Fehler beim Ansteuern des digitalen Ausganges", vbCritical - End If - - ' 5. close port - If tcpConnectionKeepAlive = False Then - EndWinSocket - tcpConnectionOpen = False - End If -End If - -End Function - - -Sub TestL246() - -Dim Datum As Date -Dim zeit As Date -Dim Gewicht As Long -Dim Waagentext As String - -WiegenInitialisieren -L246 Datum, zeit, Gewicht, Waagentext, True -L246 Datum, zeit, Gewicht, Waagentext, True -L246 Datum, zeit, Gewicht, Waagentext, True -KippenL246 (True) -KippenL246 (False) -WiegenBeenden - - -End Sub - - - -Function Kippen(onoff As Boolean) - -Dim steuerungtyp1 -Dim extbefehl - -steuerungtyp1 = GetParameter("STEUERUNGTYP") - -If steuerungtyp1 = "SERIELL" Then - KippenSeriell (onoff) -End If - -If steuerungtyp1 = "PARALLEL" Then - KippenParallel (onoff) -End If - - -If steuerungtyp1 = "L246" Then - KippenL246 (onoff) -End If - -If steuerungtyp1 = "EXTERN" Then - extbefehl = GetParameter("STEUERUNGEXTERN") - If Not IsNull(extbefehl) And onoff = True Then - Shell extbefehl, vbMinimizedFocus - Else - MsgBox "Externes Programm nicht gefunden!", vbCritical - End If -End If - - -End Function - - - -Function KippenSeriell(onoff As Boolean) - -' Kippen: RTS Signal von COMx der Steuerung (i.a. COM2) -' SubD 25: Pin 4, SubD 9: 7 - - Forms!FÜbernahme.XCommSteuerung.RTSEnable = onoff - -End Function - - -Function KippenParallel(onoff As Boolean) - -' Kippen: Über Datenleitungen des Ports - - -Dim port1 -Dim tport1 -Dim databyte As Byte - -port1 = GetParameter("STEUERUNGPORT") - -If Not IsNull(port1) Then - - Select Case port1 - - Case "1": tport1 = "LPT1" - - Case "2": tport1 = "LPT2" - - Case "3": tport1 = "LPT3" - - End Select - -End If - -If onoff = True Then - databyte = 255 -Else - databyte = 0 -End If - -Open tport1 For Binary Access Write As #1 -Put #1, , databyte - -Close #1 - -End Function - - -Function Freigabe(onoff As Boolean) - -Dim steuerungtyp1 -Dim extbefehl - -steuerungtyp1 = GetParameter("STEUERUNGTYP") - -If steuerungtyp1 = "L246" Then - FreigabeL246 (onoff) -End If - - -End Function - - -Sub testkippen() - -KippenParallel (True) -KippenParallel (False) - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/Report_BAuszahlung.frm b/wgmaster/vba/Report_BAuszahlung.frm deleted file mode 100644 index 6cbb4dd..0000000 --- a/wgmaster/vba/Report_BAuszahlung.frm +++ /dev/null @@ -1,29 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function - - diff --git a/wgmaster/vba/Report_BAuszahlungMGNR.frm b/wgmaster/vba/Report_BAuszahlungMGNR.frm deleted file mode 100644 index 5b03307..0000000 --- a/wgmaster/vba/Report_BAuszahlungMGNR.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function diff --git a/wgmaster/vba/Report_BBuchungsliste.frm b/wgmaster/vba/Report_BBuchungsliste.frm deleted file mode 100644 index e51047d..0000000 --- a/wgmaster/vba/Report_BBuchungsliste.frm +++ /dev/null @@ -1,28 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function - diff --git a/wgmaster/vba/Report_BUeberweisungsliste.frm b/wgmaster/vba/Report_BUeberweisungsliste.frm deleted file mode 100644 index 5b03307..0000000 --- a/wgmaster/vba/Report_BUeberweisungsliste.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function diff --git a/wgmaster/vba/Report_Mitglieder-Information.frm b/wgmaster/vba/Report_Mitglieder-Information.frm deleted file mode 100644 index 5b03307..0000000 --- a/wgmaster/vba/Report_Mitglieder-Information.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function diff --git a/wgmaster/vba/empty/Form_FBehaelter.frm b/wgmaster/vba/empty/Form_FBehaelter.frm deleted file mode 100644 index f965a18..0000000 --- a/wgmaster/vba/empty/Form_FBehaelter.frm +++ /dev/null @@ -1,5 +0,0 @@ -Private Sub BBehälterlisteDrucken_Click() - -DoCmd.OpenReport "BBehaelter", acViewPreview - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Form_FChargenBehandlungen.frm b/wgmaster/vba/empty/Form_FChargenBehandlungen.frm deleted file mode 100644 index f965a18..0000000 --- a/wgmaster/vba/empty/Form_FChargenBehandlungen.frm +++ /dev/null @@ -1,5 +0,0 @@ -Private Sub BBehälterlisteDrucken_Click() - -DoCmd.OpenReport "BBehaelter", acViewPreview - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Form_FGrosslagenGebieteSorten.frm b/wgmaster/vba/empty/Form_FGrosslagenGebieteSorten.frm deleted file mode 100644 index 8748539..0000000 --- a/wgmaster/vba/empty/Form_FGrosslagenGebieteSorten.frm +++ /dev/null @@ -1,4 +0,0 @@ -Option Compare Database -Option Explicit - - diff --git a/wgmaster/vba/empty/Form_FMitgliedInfo.frm b/wgmaster/vba/empty/Form_FMitgliedInfo.frm deleted file mode 100644 index cc2ca7d..0000000 --- a/wgmaster/vba/empty/Form_FMitgliedInfo.frm +++ /dev/null @@ -1,10 +0,0 @@ - -Private Sub Form_Activate() - -filter = "MGNR=" + Format(Forms!FLieferungen!TMGNR) - -FilterOn = True - - -End Sub - diff --git a/wgmaster/vba/empty/Form_FSortenAttribute.frm b/wgmaster/vba/empty/Form_FSortenAttribute.frm deleted file mode 100644 index f7454c2..0000000 --- a/wgmaster/vba/empty/Form_FSortenAttribute.frm +++ /dev/null @@ -1,7 +0,0 @@ - - -Private Sub BEingabe_Click() - -DoCmd.OpenForm "FSortenAttributeEingabe" - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Form_FSortenAttributeEingabe.frm b/wgmaster/vba/empty/Form_FSortenAttributeEingabe.frm deleted file mode 100644 index 8b13789..0000000 --- a/wgmaster/vba/empty/Form_FSortenAttributeEingabe.frm +++ /dev/null @@ -1 +0,0 @@ - diff --git a/wgmaster/vba/empty/Form_FZweigstellen.frm b/wgmaster/vba/empty/Form_FZweigstellen.frm deleted file mode 100644 index 96778ec..0000000 --- a/wgmaster/vba/empty/Form_FZweigstellen.frm +++ /dev/null @@ -1,3 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAbschlaege.frm b/wgmaster/vba/empty/Report_BAbschlaege.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAbschlaege.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAbwertungen.frm b/wgmaster/vba/empty/Report_BAbwertungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAbwertungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAbwertungenMGNR.frm b/wgmaster/vba/empty/Report_BAbwertungenMGNR.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAbwertungenMGNR.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAbwertungenSorte.frm b/wgmaster/vba/empty/Report_BAbwertungenSorte.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAbwertungenSorte.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAnlieferungenJahresvergleichDetail.frm b/wgmaster/vba/empty/Report_BAnlieferungenJahresvergleichDetail.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAnlieferungenJahresvergleichDetail.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAnlieferungsbestaetigung.frm b/wgmaster/vba/empty/Report_BAnlieferungsbestaetigung.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAnlieferungsbestaetigung.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAnlieferungsbestaetigungMGNR.frm b/wgmaster/vba/empty/Report_BAnlieferungsbestaetigungMGNR.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAnlieferungsbestaetigungMGNR.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAuszahlungsvarianteKopf.frm b/wgmaster/vba/empty/Report_BAuszahlungsvarianteKopf.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAuszahlungsvarianteKopf.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAuszahlungsvarianteSorten.frm b/wgmaster/vba/empty/Report_BAuszahlungsvarianteSorten.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAuszahlungsvarianteSorten.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BAuszahlungsvarianteSortenattribute.frm b/wgmaster/vba/empty/Report_BAuszahlungsvarianteSortenattribute.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BAuszahlungsvarianteSortenattribute.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BBanken.frm b/wgmaster/vba/empty/Report_BBanken.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BBanken.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BBehaelter.frm b/wgmaster/vba/empty/Report_BBehaelter.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BBehaelter.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BBewirtschaftungsarten.frm b/wgmaster/vba/empty/Report_BBewirtschaftungsarten.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BBewirtschaftungsarten.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BBuchungslisteBrutto.frm b/wgmaster/vba/empty/Report_BBuchungslisteBrutto.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BBuchungslisteBrutto.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BChargenListe.frm b/wgmaster/vba/empty/Report_BChargenListe.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BChargenListe.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BChargenStammblatt.frm b/wgmaster/vba/empty/Report_BChargenStammblatt.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BChargenStammblatt.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BChargenStammblattBehandlungen.frm b/wgmaster/vba/empty/Report_BChargenStammblattBehandlungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BChargenStammblattBehandlungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BChargenStammblattLieferungen.frm b/wgmaster/vba/empty/Report_BChargenStammblattLieferungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BChargenStammblattLieferungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BFlaechenbindungen.frm b/wgmaster/vba/empty/Report_BFlaechenbindungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BFlaechenbindungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BGebietshierarchie.frm b/wgmaster/vba/empty/Report_BGebietshierarchie.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BGebietshierarchie.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLeseplanung.frm b/wgmaster/vba/empty/Report_BLeseplanung.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLeseplanung.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLieferjournal.frm b/wgmaster/vba/empty/Report_BLieferjournal.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLieferjournal.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLieferjournalVerschluesselt.frm b/wgmaster/vba/empty/Report_BLieferjournalVerschluesselt.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLieferjournalVerschluesselt.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLiefermenge.frm b/wgmaster/vba/empty/Report_BLiefermenge.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLiefermenge.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLieferschein2.frm b/wgmaster/vba/empty/Report_BLieferschein2.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLieferschein2.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLieferschein3.frm b/wgmaster/vba/empty/Report_BLieferschein3.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLieferschein3.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLieferschein4.frm b/wgmaster/vba/empty/Report_BLieferschein4.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLieferschein4.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BLieferstatistikProOrt.frm b/wgmaster/vba/empty/Report_BLieferstatistikProOrt.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BLieferstatistikProOrt.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliedStammblatt.frm b/wgmaster/vba/empty/Report_BMitgliedStammblatt.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliedStammblatt.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliedStammblattFlächenbindungen.frm b/wgmaster/vba/empty/Report_BMitgliedStammblattFlächenbindungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliedStammblattFlächenbindungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliedStammblattMGNR.frm b/wgmaster/vba/empty/Report_BMitgliedStammblattMGNR.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliedStammblattMGNR.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliederliste.frm b/wgmaster/vba/empty/Report_BMitgliederliste.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliederliste.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliederlisteDetails.frm b/wgmaster/vba/empty/Report_BMitgliederlisteDetails.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliederlisteDetails.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliederlisteTest.frm b/wgmaster/vba/empty/Report_BMitgliederlisteTest.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliederlisteTest.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BMitgliederlisteVolllieferanten.frm b/wgmaster/vba/empty/Report_BMitgliederlisteVolllieferanten.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BMitgliederlisteVolllieferanten.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BNulllieferungen.frm b/wgmaster/vba/empty/Report_BNulllieferungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BNulllieferungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BQualitätsstatistik.frm b/wgmaster/vba/empty/Report_BQualitätsstatistik.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BQualitätsstatistik.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BQualitätsstatistikRotWeiss.frm b/wgmaster/vba/empty/Report_BQualitätsstatistikRotWeiss.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BQualitätsstatistikRotWeiss.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BQualitätsstufen.frm b/wgmaster/vba/empty/Report_BQualitätsstufen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BQualitätsstufen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BRundschreiben.frm b/wgmaster/vba/empty/Report_BRundschreiben.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BRundschreiben.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BSorten.frm b/wgmaster/vba/empty/Report_BSorten.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BSorten.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BSortenStatistikAttribute.frm b/wgmaster/vba/empty/Report_BSortenStatistikAttribute.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BSortenStatistikAttribute.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BSortenstatistik.frm b/wgmaster/vba/empty/Report_BSortenstatistik.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BSortenstatistik.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BUeberweisungslisteBrutto.frm b/wgmaster/vba/empty/Report_BUeberweisungslisteBrutto.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BUeberweisungslisteBrutto.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BUmrechnung.frm b/wgmaster/vba/empty/Report_BUmrechnung.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BUmrechnung.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BUnterlieferungenFlächenbindung.frm b/wgmaster/vba/empty/Report_BUnterlieferungenFlächenbindung.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BUnterlieferungenFlächenbindung.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BVorlage.frm b/wgmaster/vba/empty/Report_BVorlage.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BVorlage.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/empty/Report_BÜberlieferungen.frm b/wgmaster/vba/empty/Report_BÜberlieferungen.frm deleted file mode 100644 index a113526..0000000 --- a/wgmaster/vba/empty/Report_BÜberlieferungen.frm +++ /dev/null @@ -1,10 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Report_Close() -DoCmd.ShowToolbar "Datenbank", acToolbarNo -End Sub - -Private Sub Report_Open(Cancel As Integer) -DoCmd.ShowToolbar "Datenbank", acToolbarYes -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FAbschlaege.frm b/wgmaster/vba/form/Form_FAbschlaege.frm deleted file mode 100644 index 2f973f9..0000000 --- a/wgmaster/vba/form/Form_FAbschlaege.frm +++ /dev/null @@ -1,38 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BAbschlaege" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub - - -Private Sub TAZAS_Exit(Cancel As Integer) - -If Not IsNull(TAZAS) And Not IsNull(TAZASProzent) Then - MsgBox "Es kann pro Zu/Abschlag entweder ein absoluter Wert oder ein Prozentwert angegeben werden, aber nicht beides !", vbCritical - TAZAS = "" -End If - -End Sub - -Private Sub TAZASProzent_Exit(Cancel As Integer) - -If Not IsNull(TAZAS) And Not IsNull(TAZASProzent) Then - MsgBox "Es kann pro Zu/Abschlag entweder ein absoluter Wert oder ein Prozentwert angegeben werden, aber nicht beides !", vbCritical - TAZASProzent = "" -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FAllgemein.frm b/wgmaster/vba/form/Form_FAllgemein.frm deleted file mode 100644 index 1556e9c..0000000 --- a/wgmaster/vba/form/Form_FAllgemein.frm +++ /dev/null @@ -1,58 +0,0 @@ -Option Compare Database -Option Explicit - - - -Private Sub Form_Close() - -'If Not IsNull(GetParameter("LIEFERRECHT/GA1")) Then TLieferrecht1 = CDbl(GetParameter("LIEFERRECHT/GA1")) -'If Not IsNull(GetParameter("LIEFERRECHT/GA2")) Then TLieferrecht2 = CDbl(GetParameter("LIEFERRECHT/GA2")) -'If Not IsNull(GetParameter("LIEFERPFLICHT/GA1")) Then TLieferpflicht1 = CDbl(GetParameter("LIEFERPFLICHT/GA1")) -'If Not IsNull(GetParameter("LIEFERPFLICHT/GA2")) Then TLieferpflicht2 = CDbl(GetParameter("LIEFERPFLICHT/GA2")) - -If Not IsNull(TEurofaktor) Then SetParameter "EUROFAKTOR", TEurofaktor -If Not IsNull(TMwSt1) Then SetParameter "MWST1", TMwSt1 -If Not IsNull(TMwSt2) Then SetParameter "MWST2", TMwSt2 -If Not IsNull(TMwSt3) Then SetParameter "MWST3", TMwSt3 -If Not IsNull(TGB) Then SetParameter "GB", TGB -If Not IsNull(TRebelabzug) Then SetParameter "REBELABZUG", TRebelabzug - -If Not IsNull(TLieferrecht1) Then SetParameter "LIEFERRECHT/GA1", TLieferrecht1 -If Not IsNull(TLieferrecht2) Then SetParameter "LIEFERRECHT/GA2", TLieferrecht2 -If Not IsNull(TLieferpflicht1) Then SetParameter "LIEFERPFLICHT/GA1", TLieferpflicht1 -If Not IsNull(TLieferpflicht2) Then SetParameter "LIEFERPFLICHT/GA2", TLieferpflicht2 - -If Not IsNull(TMAXERTRAG) Then SetParameter "MAXERTRAG", TMAXERTRAG -If Not IsNull(TAufschlagVollieferant) Then SetParameter "AUFSCHLAGVOLLLIEFERANT", TAufschlagVollieferant - - -End Sub - -Private Sub Form_Open(Cancel As Integer) - - -If Not IsNull(GetParameter("EUROFAKTOR")) Then TEurofaktor = CDbl(GetParameter("EUROFAKTOR")) -If Not IsNull(GetParameter("MWST1")) Then TMwSt1 = CDbl(GetParameter("MWST1")) -If Not IsNull(GetParameter("MWST2")) Then TMwSt2 = CDbl(GetParameter("MWST2")) -If Not IsNull(GetParameter("MWST3")) Then TMwSt3 = CDbl(GetParameter("MWST3")) - -If Not IsNull(GetParameter("GB")) Then TGB = CDbl(GetParameter("GB")) -If Not IsNull(GetParameter("REBELABZUG")) Then TRebelabzug = CDbl(GetParameter("REBELABZUG")) - -If Not IsNull(GetParameter("LIEFERRECHT/GA1")) Then TLieferrecht1 = CDbl(GetParameter("LIEFERRECHT/GA1")) -If Not IsNull(GetParameter("LIEFERRECHT/GA2")) Then TLieferrecht2 = CDbl(GetParameter("LIEFERRECHT/GA2")) -If Not IsNull(GetParameter("LIEFERPFLICHT/GA1")) Then TLieferpflicht1 = CDbl(GetParameter("LIEFERPFLICHT/GA1")) -If Not IsNull(GetParameter("LIEFERPFLICHT/GA2")) Then TLieferpflicht2 = CDbl(GetParameter("LIEFERPFLICHT/GA2")) - -If Not IsNull(GetParameter("MAXERTRAG")) Then TMAXERTRAG = CDbl(GetParameter("MAXERTRAG")) - -If Not IsNull(GetParameter("AUFSCHLAGVOLLLIEFERANT")) Then TAufschlagVollieferant = CDbl(GetParameter("AUFSCHLAGVOLLLIEFERANT")) - - -End Sub - - - - - - diff --git a/wgmaster/vba/form/Form_FAuszahlung.frm b/wgmaster/vba/form/Form_FAuszahlung.frm deleted file mode 100644 index a97bdda..0000000 --- a/wgmaster/vba/form/Form_FAuszahlung.frm +++ /dev/null @@ -1,1170 +0,0 @@ - - - -Private Sub BAddieren_Click() - -Dim konst1 - -If Not IsNull(Forms!FAuszahlung!TSNR) Then - - konst1 = InputBox("Welchen Wert wollen Sie zu allen Qualitätszuschläge der ausgewählten Sorte addieren ?") - - If Not IsNull(konst1) Then - - Dim db1 As Database - Dim rs1 As Recordset - Set db1 = CurrentDb - If IsNull(TSANR) Then - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND Isnull(SANR)") - Else - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND SANR='" + TSANR + "'") - End If - While Not rs1.EOF - rs1.Edit - rs1!Betrag = rs1!Betrag + konst1 - rs1.Update - rs1.MoveNext - Wend - rs1.Close - FUnter1.Requery - - End If - -End If - -End Sub - -Function GetFilter() - -Dim filter1 As String - - -If IsNull(TZNR) Then - filter1 = "Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr) -Else - filter1 = "Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr) + " AND ZNR=" + Forms!FAuszahlung!TZNR -End If - -If Not IsNull(TVon) And Not IsNull(TBis) Then - - filter1 = filter1 + " AND " - If OSortierung = 1 Then - ' sort by mgnr - filter1 = filter1 + "MGNR>=" + Format(TVon) + " AND MGNR<=" + Format(TBis) - Else - ' sort by plz - filter1 = filter1 + "PLZ>='" + Format(TVon) + "' AND PLZ<= '" + Format(TBis) + "'" - End If - -End If - -GetFilter = filter1 - - -End Function - -Private Sub BAuszahlungDrucken_Click() - -Dim filter1 - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -If IsNull(TFusstext.Value) Then - SetParameter "AUSZAHLUNGTEXT", " " -Else - SetParameter "AUSZAHLUNGTEXT", TFusstext.Value -End If - -If IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_BF")) Then - SetParameter "AUSZAHLUNGZUSATZTEXT_BF", " " -End If - -If IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_PA")) Then - SetParameter "AUSZAHLUNGZUSATZTEXT_PA", " " -End If - - -filter1 = GetFilter - -'filter1 = "SELECT * FROM TLieferungen WHERE " + filter1 -'MsgBox (getfilter) - -DoCmd.Maximize -Select Case OSortierung - -Case 1: - DoCmd.OpenReport "BAuszahlungMGNR", acPreview, , filter1 -Case 2: - DoCmd.OpenReport "BAuszahlung", acPreview, , filter1 - -End Select - - - -End Sub - - -Private Sub BBerechnen_Click() - - -If IsNull(TLesejahr) Or TLesejahr < 1900 Then - MsgBox ("Bitte zuerst das Lesejahr eingeben !") - TLesejahr.SetFocus - Exit Sub -End If - - - Select Case Forms!FAuszahlung!TZahlungNr - - Case 1: - If DSum("BTeilzahlung1", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 1.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Exit Sub - End If - End If - Case 2: - If DSum("BTeilzahlung2", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 2.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Exit Sub - End If - End If - Case 3: - If DSum("BTeilzahlung3", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 3.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Exit Sub - End If - End If - Case 4: - If DSum("BTeilzahlung4", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 4.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Exit Sub - End If - End If - Case 5: - If DSum("BTeilzahlung5", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 5.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Exit Sub - End If - End If - Case 6: - If DSum("BEndauszahlung", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine Endauszahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Exit Sub - End If - End If - End Select - - -If MsgBox("Dieser Vorgang kann länger dauern ! Fortfahren ?", vbYesNo) = vbYes Then - - DoCmd.Hourglass True - - '1. Gebunden/Gebunden Grundsorte/Ungebunden bestimmen - GebundenBerechnen TLesejahr, OSortenAttributInFlaechenbindungOptional, OGebunden - - - '2. Berechnen der Tarife f. alle Lieferungen - - Dim db1 As Database - Dim rs1 As Recordset - Dim rs2 As Recordset - Dim rs3 As Recordset - - Dim GewichtGebunden As Double - Dim GewichtGebundenGrundsorte As Double - - - Dim ErgebnisGewicht As Double - Dim ErgebnisBetrag As Double - Dim ErgebnisGebunden As Double - Dim ErgebnisDatensaetze As Double - Dim ErgebnisAktDatensatz As Double - - Dim GB As Double ' Grundbetrag - Dim GZS As Double ' Gebundenzuschlag - Dim GZS_SQ As Double ' Gebundenzuschlag sorten/qualitätsabhängig - Dim SQZS As Double ' Sorten/Qualitätszuschlag - Dim QSZS As Double 'Qualitätsstufenzuschlag - - Dim GZS_SQ_Grundsorte As Double - Dim SQZS_Grundsorte As Double - - Dim ZSZS As Double ' Zweigstellenzuschlag - Dim RIZS As Double ' Riedzuschlag - Dim GEZS As Double ' Gemeindezuschlag - Dim GRZS As Double ' Großlagenzuschlag - Dim WEZS As Double ' Weinbaugebietszuschlag - Dim REZS As Double ' Regionzuschlag - Dim REBELFAKT As Double - Dim AZAS As Double ' Abschläge - - Dim BetragProKgUngebunden As Double - Dim BetragProKgGebunden As Double - Dim BetragProKgGebundenGrundsorte As Double - - Dim query1 As String - Dim query2 As String - - Dim gesamtpunkte_gebunden As Double - Dim gesamtpunkte_ungebunden As Double - Dim gesamtpunkte_gebunden_grundsorte As Double - - Dim actBetrag As Double - - - Set db1 = CurrentDb - - query1 = "SELECT * FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(Forms!FAuszahlung!TLesejahr) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR" - Set rs1 = db1.OpenRecordset(query1) 'Lieferungen - - - If IsNull(TGB) Then - GB = 0 - Else - GB = TGB - End If - - - If IsNull(TGBZS) Then - GZS = 0 - Else - GZS = TGBZS - End If - - - ErgebnisGewicht = 0 - ErgebnisBetrag = 0 - ErgebnisGebunden = 0 - ErgebnisDatensaetze = 0 - ErgebnisAktDatensatz = 0 - - - While Not rs1.EOF - - - ZSZS = 0 - RIZS = 0 - GEZS = 0 - GRZS = 0 - WEZS = 0 - REZS = 0 - - - - rs1.Edit - - - ' Gebunden - GewichtGebunden = rs1("BGewichtGebunden") - GewichtGebundenGrundsorte = rs1("BGewichtGebundenGrundsorte") - - ' Qualitätsstufenzuschlag - 'If rs1("LINR") = 178227 Then - ' MsgBox ("Lieferung gefunden") - 'End If - - If IsNull(rs1("SANR")) Or rs1("SANR") = "" Then - query2 = "SELECT Betrag AS QSZS,TAuszahlungSortenQualitätsstufe.SNR,TAuszahlungSortenQualitätsstufe.SANR FROM TAuszahlungSortenQualitätsstufe INNER JOIN TLieferungen ON (TAuszahlungSortenQualitätsstufe.SNR = TLieferungen.SNR AND TAuszahlungSortenQualitätsstufe.QSNR=TLieferungen.QSNR) WHERE (TAuszahlungSortenQualitätsstufe.SANR IS NULL or TAuszahlungSortenQualitätsstufe.SANR='') AND AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TLieferungen.LINR=" + Format(rs1("LINR")) - 'query2 = "SELECT Betrag AS QSZS,TAuszahlungSortenQualitätsstufe.SNR,TAuszahlungSortenQualitätsstufe.SANR FROM TAuszahlungSortenQualitätsstufe INNER JOIN TLieferungen ON (TAuszahlungSortenQualitätsstufe.SNR = TLieferungen.SNR AND TAuszahlungSortenQualitätsstufe.QSNR=TLieferungen.QSNR) WHERE TAuszahlungSortenQualitätsstufe.SANR IS NULL AND AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TLieferungen.LINR=" + Format(rs1("LINR")) - Else - query2 = "SELECT Betrag AS QSZS, TAuszahlungSortenQualitätsstufe.SNR, TAuszahlungSortenQualitätsstufe.SANR FROM TAuszahlungSortenQualitätsstufe INNER JOIN TLieferungen ON (TAuszahlungSortenQualitätsstufe.SNR = TLieferungen.SNR AND TAuszahlungSortenQualitätsstufe.QSNR=TLieferungen.QSNR AND TAuszahlungSortenQualitätsstufe.SANR=TLieferungen.SANR) WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TLieferungen.LINR=" + Format(rs1("LINR")) - End If - - - Set rs2 = db1.OpenRecordset(query2) - - ' Falls ein Qualitätsstufenzuschlag gefunden wird, wird der Sorten & Qualitätszuschlag nicht angewendet! - If Not rs2.EOF Then - - '1. Qualitätsstufenzuschlag gefunden - rs2.MoveLast - 'If rs2(1) = "BP" And IsNull(rs1("SANR")) Then - ' MsgBox (rs2.recordcount) - ' MsgBox (rs2(2)) - 'End If - QSZS = rs2("QSZS") - rs2.Close - SQZS = 0 - SQZS_Grundsorte = 0 - 'Kein Gebundenzuschlag - GZS = 0 - GZS_SQ = 0 - - - Else - QSZS = 0 - rs2.Close - '2. Kein Qualitätsstufenzuschlag gefunden - ' Sorten- und Qualitätszuschlag anwenden - - 'Anfrage für genau diese Sorte und OriginalOechsle und ungebunden - If IsNull(rs1("SANR")) Or rs1("SANR") = "" Then - query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=False AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')" - Else - query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) AND (TAuszahlungSorten.SANR = TLieferungen.SANR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=False AND TLieferungen.LINR=" + Format(rs1("LINR")) - End If - Set rs2 = db1.OpenRecordset(query2) - - If rs2.EOF Then - MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (ungebunden)! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - SQZS = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR)) - rs2.MoveLast - If rs2.recordcount > 1 Then - MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - rs2.Close - - 'Grundsorte - query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=False AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')" - Set rs2 = db1.OpenRecordset(query2) - If rs2.EOF Then - MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (ungebunden)! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - SQZS_Grundsorte = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR)) - rs2.MoveLast - If rs2.recordcount > 1 Then - MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - rs2.Close - - ' Gebundenzuschlag Sorten/Qualitätsabhängig - 'Anfrage für genau diese Sorte und Oechsle und gebunden - If IsNull(rs1("SANR")) Or rs1("SANR") = "" Then - query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=True AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')" - Else - query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) AND (TAuszahlungSorten.SANR = TLieferungen.SANR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=True AND TLieferungen.LINR=" + Format(rs1("LINR")) - End If - Set rs2 = db1.OpenRecordset(query2) - If rs2.EOF Then - MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1(SNR) + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - GZS_SQ = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR)) - rs2.MoveLast - If rs2.recordcount > 1 Then - MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - rs2.Close - GZS_SQ = GZS_SQ - SQZS - - 'Grundsorte - query2 = "SELECT TAuszahlungSorten.Betrag AS SQZS, TLieferungen.LINR FROM TAuszahlungSorten INNER JOIN TLieferungen ON (TAuszahlungSorten.Oechsle = TLieferungen.Oechsle) AND (TAuszahlungSorten.SNR = TLieferungen.SNR) WHERE TAuszahlungSorten.AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND TAuszahlungSorten.gebunden=True AND TLieferungen.LINR=" + Format(rs1("LINR")) + " AND (Isnull(TAuszahlungSorten.SANR) or TAuszahlungSorten.SANR='')" - Set rs2 = db1.OpenRecordset(query2) - If rs2.EOF Then - MsgBox "FEHLER! Kein Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1(SNR) + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - GZS_SQ_Grundsorte = rs2!SQZS 'DFirst("Betrag", "SELECT * FROM TAuszahlungSorten", "SNR='" + rs1!SNR + "' AND Oechlse=" + Format(rs1!Oechsle) + " AND AZNR=" + Format(TAZNR)) - rs2.MoveLast - If rs2.recordcount > 1 Then - MsgBox "FEHLER! Mehr als Auszahlungswert für Lieferschein " + Format(rs1("Lieferscheinnummer")) + ", Sorte=" + rs1("TLieferungen.SNR") + ", Oechsle=" + Format(rs1("Oechsle")) + " gefunden (gebunden)! Berechnung wird abgebrochen!", vbCritical - rs2.Close - rs1.Close - Exit Sub - End If - rs2.Close - GZS_SQ_Grundsorte = GZS_SQ_Grundsorte - SQZS_Grundsorte - - - - End If - - If OZWZS Then - ' Zweigstellenzuschlag: ZNR ist nicht Stammzweigstelle des Mitglieds - If rs1![TMitglieder.ZNR] <> rs1![TLieferungen.ZNR] Then - ZSZS = DFirst("ZSZS", "TZweigstellen", "ZNR=" + Format(rs1![TLieferungen.ZNR])) - End If - End If - - If ORIZS Then - ' Riedzuschlag - If Not IsNull(rs1!RNR) Then - RIZS = DFirst("RZS", "TRiede", "RNR=" + Format(rs1!RNR)) - End If - End If - - If OGEZS Then - ' Gemeindezuschlag - If Not IsNull(rs1!GNR) Then - GEZS = DFirst("GZS", "TGemeinden", "GNR=" + Format(rs1!GNR)) - End If - End If - - If OGRZS Then - ' Großlagenzuschlag - If Not IsNull(rs1!GNR) Then - query1 = "SELECT * FROM TGrosslagen INNER JOIN TGemeinden ON TGrosslagen.GLNR = TGemeinden.GLNR WHERE GNR=" + Format(rs1!GNR) - Set rs3 = db1.OpenRecordset(query1) - GRZS = rs3!GLZS - rs3.Close - End If - End If - - - If OWEZS Then - ' Gebietszuschlag - - If Not IsNull(rs1!GNR) Then - query1 = "SELECT * FROM TGebiete INNER JOIN (TGrosslagen INNER JOIN TGemeinden ON TGrosslagen.GLNR = TGemeinden.GLNR) ON TGebiete.WBGNR = TGrosslagen.WBGNR WHERE GNR=" + Format(rs1!GNR) - Set rs3 = db1.OpenRecordset(query1) - WEZS = rs3!WBGZS - rs3.Close - - End If - End If - If OREZS Then - ' Regionzuschlag - If Not IsNull(rs1!GNR) Then - query1 = "SELECT * FROM TRegionen INNER JOIN (TGebiete INNER JOIN (TGrosslagen INNER JOIN TGemeinden ON TGrosslagen.GLNR = TGemeinden.GLNR) ON TGebiete.WBGNR = TGrosslagen.WBGNR) ON TRegionen.RGNR = TGebiete.RGNR WHERE GNR=" + Format(rs1!GNR) - Set rs3 = db1.OpenRecordset(query1) - REZS = rs3!RZS - rs3.Close - End If - End If - - 'Volllieferantenzuschlag - - - If rs1!Volllieferant = True Then - VLZS = TAufschlagVolllieferant - 'MsgBox (rs1![TMitglieder.MGNR]) - If IsNull(VLZS) Then VLZS = 0 - Else - VLZS = 0 - End If - - REBELFAKT = 1 - - ' Gerebelt bzw. Rebelfaktor - If IsNull(TRebelzuschlag) Then TRebelzuschlag = 0 - rs1!BRebelzuschlag = 0 - If Not IsNull(TRebelzuschlag) And rs1!Gerebelt = True Then - REBELFAKT = (100 + TRebelzuschlag) / 100 - rs1!BRebelzuschlag = TRebelzuschlag - End If - - 'Zu-/Abschläge absolut - If OAZAS Then - query1 = "SELECT TAbschlaege.* FROM TAbschlaege INNER JOIN TLieferungAbschlag ON TAbschlaege.ASNR = TLieferungAbschlag.ASNR WHERE LINR=" + Format(rs1!LINR) - AZAS = 0 - Set rs3 = db1.OpenRecordset(query1) - While Not rs3.EOF - If Not IsNull(rs3!AZAS) Then - AZAS = AZAS + rs3!AZAS - End If - rs3.MoveNext - Wend - rs3.Close - End If - - - - - ' Berechnung der Beträge pro kg - 'If GZS < 0 Or GZS_SQ < 0 Then - ' MsgBox ("GZS oder GZS_SQ<0") - ' MsgBox (rs1!LINR) - 'End If - - - BetragProKgUngebunden = (GB + QSZS + SQZS + ZSZS + RIZS + GEZS + GRZS + WEZS + REZS + VLZS + AZAS) - - '2.1.2012: Falls Qualitätsstufenzuschlag zum Tragen kommt gibt es keinen gebundenen Tarif. - If QSZS > 0 Then - BetragProKgGebunden = 0 - Else - BetragProKgGebunden = BetragProKgUngebunden + GZS + GZS_SQ - End If - - - BetragProKgGebundenGrundsorte = (GB + SQZS_Grundsorte + ZSZS + RIZS + GEZS + GRZS + WEZS + REZS + VLZS + AZAS) + GZS + GZS_SQ_Grundsorte - - 'Zu-/Abschläge % - ABSCHLAGFAKTOR = 1 - If OAZAS Then - query1 = "SELECT TAbschlaege.* FROM TAbschlaege INNER JOIN TLieferungAbschlag ON TAbschlaege.ASNR = TLieferungAbschlag.ASNR WHERE LINR=" + Format(rs1!LINR) - Set rs3 = db1.OpenRecordset(query1) - While Not rs3.EOF - If Not IsNull(rs3!AZASProzent) Then - ABSCHLAGFAKTOR = ABSCHLAGFAKTOR * (100 + rs3!AZASProzent) / 100 - End If - rs3.MoveNext - Wend - rs3.Close - End If - BetragProKgUngebunden = BetragProKgUngebunden * ABSCHLAGFAKTOR - BetragProKgGebunden = BetragProKgGebunden * ABSCHLAGFAKTOR - BetragProKgGebundenGrundsorte = BetragProKgGebundenGrundsorte * ABSCHLAGFAKTOR - - gesamtpunkte_gebunden = BetragProKgGebunden - gesamtpunkte_gebunden_grundsorte = BetragProKgGebundenGrundsorte - gesamtpunkte_ungebunden = BetragProKgUngebunden - - - ' Berücksichtigung des Ausgabefaktors - - If IsNull(TAusgabefaktor) Then TAusgabefaktor = 1 - BetragProKgUngebunden = BetragProKgUngebunden * TAusgabefaktor - BetragProKgGebunden = BetragProKgGebunden * TAusgabefaktor - BetragProKgGebundenGrundsorte = BetragProKgGebundenGrundsorte * TAusgabefaktor - - ' Rundung der Beträge pro kg - - BetragProKgUngebunden = Runden(BetragProKgUngebunden, 3) - BetragProKgGebunden = Runden(BetragProKgGebunden, 3) - BetragProKgGebundenGrundsorte = Runden(BetragProKgGebundenGrundsorte, 3) - - - ' Berechnung von actBetrag - If Not IsNull(rs1!Gewicht) Then - actBetrag = (rs1!Gewicht - GewichtGebunden - GewichtGebundenGrundsorte) * REBELFAKT * BetragProKgUngebunden + REBELFAKT * GewichtGebunden * BetragProKgGebunden + REBELFAKT * GewichtGebundenGrundsorte * BetragProKgGebundenGrundsorte - Else - actBetrag = 0 - End If - - - 'actBetrag Runden - 'rs1!BProbeauszahlung = actBetrag - actBetrag = Runden(actBetrag, 2) - - ' Berechnete Felder aktualisieren - - If IsNull(rs1!BTeilzahlung1) Then - rs1!BTeilzahlung1 = 0 - End If - If IsNull(rs1!BTeilzahlung2) Then - rs1!BTeilzahlung2 = 0 - End If - If IsNull(rs1!BTeilzahlung3) Then - rs1!BTeilzahlung3 = 0 - End If - If IsNull(rs1!BTeilzahlung4) Then - rs1!BTeilzahlung4 = 0 - End If - If IsNull(rs1!BTeilzahlung5) Then - rs1!BTeilzahlung5 = 0 - End If - - - Select Case Forms!FAuszahlung!TZahlungNr - - Case 1: - rs1!BTeilzahlung1 = actBetrag - Case 2: - rs1!BTeilzahlung2 = actBetrag - Case 3: - rs1!BTeilzahlung3 = actBetrag - Case 4: - rs1!BTeilzahlung4 = actBetrag - Case 5: - rs1!BTeilzahlung5 = actBetrag - Case 6: - rs1!BEndauszahlung = actBetrag - Case 7: - rs1!BProbeauszahlung = actBetrag - End Select - - - 'BAbschlaegestring updaten - rs1!BAbschlaegeString = GetAbschlägeAsString(rs1!LINR) - - 'Gesamtpunkteanzahl - If TAusgabefaktor <> 1 Then - 'nur wenn Ausgabefaktor ungleich 1 - If (GewichtGebunden = rs1!Gewicht) Then - 'alles Gebunden - rs1!BAbschlaegeString = Format(gesamtpunkte_gebunden) + " Punkte/kg " + rs1!BAbschlaegeString - Else - If (GewichtGebunden = 0) Then - 'alles ungebunden - rs1!BAbschlaegeString = Format(gesamtpunkte_ungebunden) + " Punkte/kg " + rs1!BAbschlaegeString - Else - rs1!BAbschlaegeString = Format(gesamtpunkte_gebunden) + "/" + Format(gesamtpunkte_ungebunden) + " Punkte/kg " + rs1!BAbschlaegeString - End If - End If - End If - - 'rs1!BGewichtGebunden = GewichtGebunden - rs1!BBetragUngebunden = BetragProKgUngebunden - rs1!BBetragGebunden = BetragProKgGebunden - rs1!BBetragGebundenGrundsorte = BetragProKgGebundenGrundsorte - ' BetragGebunden pro kg - test1 = rs1!Lieferscheinnummer - - rs1.Update - - ' Ausgabe der laufenden Ergebnisse - If Not IsNull(rs1!Gewicht) Then - ErgebnisGewicht = ErgebnisGewicht + rs1!Gewicht - End If - ErgebnisBetrag = ErgebnisBetrag + actBetrag - ErgebnisGebunden = ErgebnisGebunden + GewichtGebunden + GewichtGebundenGrundsorte - ErgebnisDatensaetze = rs1.recordcount - ErgebnisAktDatensatz = ErgebnisAktDatensatz + 1 - - If ErgebnisAktDatensatz Mod 10 = 0 Then - - TErgebnisGewicht = ErgebnisGewicht - TErgebnisBetrag = ErgebnisBetrag - TErgebnisGebunden = ErgebnisGebunden - TErgebnisDatensaetze = ErgebnisDatensaetze - TErgebnisAktDatensatz = ErgebnisAktDatensatz - DoEvents - End If - - rs1.MoveNext - Wend - -rs1.Close - -End If - - TErgebnisGewicht = ErgebnisGewicht - TErgebnisBetrag = ErgebnisBetrag - TErgebnisGebunden = ErgebnisGebunden - TErgebnisDatensaetze = ErgebnisDatensaetze - TErgebnisAktDatensatz = ErgebnisAktDatensatz - DoCmd.Hourglass False - -End Sub - - - - - - -Private Sub Befehl285_Click() - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -DoCmd.Maximize -DoCmd.OpenReport "BUeberweisungsliste", acViewPreview - -End Sub - -Private Sub Befehl286_Click() - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -DoCmd.Maximize -DoCmd.OpenReport "BBuchungsliste", acViewPreview - -End Sub - - -Private Sub Befehl301_Click() - -MsgBox (OGebunden) - -End Sub - - -Private Sub BExportExcel_Click() - -Dim SEL1 As String -Dim GROUP1 As String -Dim where1 As String -Dim order1 As String -Dim query1 -Dim savepath1 - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -SEL1 = "SELECT DISTINCT TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1 AS Bank, TMitglieder.BHKontonummer, CCur(Sum(IIf([Formulare]![FAuszahlung]![TZahlungNr]=1,[BTeilzahlung1],IIf([Formulare]![FAuszahlung]![TZahlungNr]=2,[BTeilzahlung2],IIf([Formulare]![FAuszahlung]![TZahlungNr]=3,[BTeilzahlung3],IIf([Formulare]![FAuszahlung]![TZahlungNr]=4,[BTeilzahlung4],IIf([Formulare]![FAuszahlung]![TZahlungNr]=5,[BTeilzahlung5],IIf([Formulare]![FAuszahlung]![TZahlungNr]=6,[BEndauszahlung],[BProbeauszahlung])))))))) AS BetragNetto, First(IIf([Buchführend],Getparameter('MWST2'),GetPArameter('MWST1'))) AS MwStProzent, CCur(BetragNetto*MwStProzent/100) as MwStBetrag, CCur(BetragNetto*(MwStProzent+100)/100) as BetragBrutto" -SEL1 = SEL1 + " FROM TBanken RIGHT JOIN (TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ " -GROUP1 = " GROUP BY TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1, TMitglieder.BHKontonummer " - -Select Case OSortierung - -Case 1: order1 = " ORDER BY TMitglieder.MGNR " - -Case 2: order1 = " ORDER BY TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.Nachname, TMitglieder.Vorname " - -End Select - -where1 = " WHERE Year(Datum)=" + Format(TLesejahr) + " AND Storniert=false " - - -If Not IsNull(TZNR) And TZNR <> "" Then - where1 = where1 + " AND TLieferungen.ZNR=" + Format(TZNR) -End If - -If Not IsNull(TVon) And TVon >= 0 Then - - If OSortierung = 1 Then - where1 = where1 + " AND TLieferungen.MGNR>=" + Format(TVon) + " " - Else - where1 = where1 + " AND TMitglieder.PLZ>=" + Format(TVon) + " " - End If - -End If - -If Not IsNull(TBis) And TBis >= 0 Then - - If OSortierung = 1 Then - where1 = where1 + " AND TLieferungen.MGNR<=" + Format(TBis) + " " - Else - where1 = where1 + " AND TMitglieder.PLZ<=" + Format(TBis) + " " - End If - - - -End If - - -query1 = SEL1 + where1 + GROUP1 + order1 - -savepath1 = InputBox("Excel Datei speichern unter:", "EXCEL DATEI EXPORTIEREN", "C:\Eigene Dateien\auszahlung.xls") -If IsNull(savepath) Or savepath1 = "" Then - Exit Sub -End If - -DoCmd.Hourglass True - -queryname1 = "AAuszahlungExport" -Dim db1 As Database -Set db1 = CurrentDb - -On Error Resume Next -DoCmd.DeleteObject acQuery, queryname1 -'MsgBox (query1) -db1.CreateQueryDef queryname1, query1 -db1.Close - -DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel5, queryname1, savepath1, True - -DoCmd.Hourglass False - - -End Sub - -Private Sub BExport_Click() - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -DoCmd.OpenForm "MExportAuszahlung" - -End Sub - -Private Sub BGebunden_Click() - -Dim konst1 -Dim minoechsle - - konst1 = InputBox("Welchen Wert wollen Sie zu allen 'Gebunden'-Qualitätszuschlägen addieren ?") - - If Not IsNull(konst1) And konst1 <> "" Then - - Dim db1 As Database - Dim rs1 As Recordset - Set db1 = CurrentDb - - minoechsle = DFirst("Von", "TQualitaetsstufen", "QSNR=3") - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND gebunden=true AND Oechsle>=" + Format(minoechsle)) - While Not rs1.EOF - rs1.Edit - rs1!Betrag = rs1!Betrag + konst1 - rs1.Update - rs1.MoveNext - Wend - rs1.Close - FUnter1.Requery - - End If - - -End Sub - -Private Sub BKonstant_Click() - -Dim konst1 - -If Not IsNull(Forms!FAuszahlung!TSNR) Then - - konst1 = InputBox("Auf welchen Wert wollen Sie alle Qualitätszuschläge der ausgewählten Sorte setzen ?") - - If Not IsNull(konst1) And konst1 <> "" Then - - Dim db1 As Database - Dim rs1 As Recordset - Set db1 = CurrentDb - If IsNull(TSANR) Then - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND Isnull(SANR)") - Else - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + Forms!FAuszahlung!TSNR + "' AND Gebunden=" + Format(Forms!FAuszahlung!TGebunden) + " AND SANR='" + TSANR + "'") - End If - While Not rs1.EOF - rs1.Edit - rs1!Betrag = konst1 - rs1.Update - rs1.MoveNext - Wend - rs1.Close - FUnter1.Requery - - End If - -End If - -End Sub - -Private Sub BKopieren_Click() - -If Not IsNull(Forms!FAuszahlung!TSNR) Then - DoCmd.OpenForm "FAuszahlungSortenAuswahl" -End If - -End Sub - - - -Private Sub BParameter_Click() - -If Not IsNull(Forms!FAuszahlung!TSNR) Then - DoCmd.OpenForm "FAuszahlungParameter", acNormal -End If - -End Sub - -Private Sub BUngebundenGebunden_Click() - -If MsgBox("Wollen Sie alle ungebundenen Sorten/Qualitätszuschläge auf die entsprechenden gebundenen Sorten/Qualitätszuschläge übertragen ?", vbYesNo) = vbYes Then - - Dim db1 As Database - Dim rs1 As Recordset - Dim rs2 As Recordset - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND Gebunden=False") - While Not rs1.EOF - If IsNull(rs1("SANR")) Then - Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + rs1!SNR + "' And Oechsle=" + Format(rs1!Oechsle) + " AND Gebunden=True AND SANR=Null") - Else - Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + rs1!SNR + "' And Oechsle=" + Format(rs1!Oechsle) + " AND Gebunden=True AND SANR='" + Format(rs1!SANR) + "'") - End If - If Not rs2.EOF Then - rs2.Edit - rs2!Betrag = rs1!Betrag - rs2.Update - rs2.Close - End If - rs1.MoveNext - Wend - rs1.Close - FUnter1.Requery - - -End If - - -End Sub - - - -Private Sub BVonVorigerTeilauszahlung_Click() - -NummerierungVonVorigerAuszahlungFortsetzen - -End Sub - -Sub NummerierungVonVorigerAuszahlungFortsetzen() - -BerechneErsteNummer -BerechneLetzteNummer - -End Sub - -Sub BerechneErsteNummer() - -Dim maxNumber - -'Erste Nummer bestimmen -maxNumber = DMax("TraubengutschriftNummerBis", "TAuszahlung", "Lesejahr=" + Format(TLesejahr) + " AND TraubengutschriftenNummerieren=True AND AZNR<>" + Format(TAZNR) + " AND TeilzahlungNr<" + Format(TZahlungNr)) - -If Not IsNull(maxNumber) Then - TTraubengutschriftNummerVon = maxNumber + 1 -Else - TTraubengutschriftNummerVon = 1 -End If - - -End Sub - -Sub BerechneLetzteNummer() - -Dim db1 As Database -Dim rs1 As Recordset - -'Letzte Nummer bestimmen -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT DISTINCT TMitglieder.MGNR FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(Forms!FAuszahlung!TLesejahr)) -rs1.MoveLast -TTraubengutschriftNummerBis = TTraubengutschriftNummerVon + rs1.recordcount - 1 -rs1.Close - -End Sub - - -Private Sub Form_Open(Cancel As Integer) - -OSortierung = 1 -TFusstext = GetParameter("AUSZAHLUNGTEXT") -'TZNR = 1 -TGebunden = 0 - -If OTraubengutschriftenNummerieren Then - XNummernkreisRahmen.Visible = True - TTraubengutschriftNummerVon.Visible = True - TTraubengutschriftNummerBis.Visible = True - BVonVorigerTeilauszahlung.Visible = True -Else - XNummernkreisRahmen.Visible = False - TTraubengutschriftNummerVon.Visible = False - TTraubengutschriftNummerBis.Visible = False - BVonVorigerTeilauszahlung.Visible = False -End If - -End Sub - - - - - -Private Sub OTraubengutschriftenNummerieren_Click() - -If OTraubengutschriftenNummerieren Then - XNummernkreisRahmen.Visible = True - TTraubengutschriftNummerVon.Visible = True - TTraubengutschriftNummerBis.Visible = True - BVonVorigerTeilauszahlung.Visible = True -Else - XNummernkreisRahmen.Visible = False - TTraubengutschriftNummerVon.Visible = False - TTraubengutschriftNummerBis.Visible = False - BVonVorigerTeilauszahlung.Visible = False - TTraubengutschriftNummerVon = "" - TTraubengutschriftNummerBis = "" -End If - -End Sub - -Private Sub TFusstext_Exit(Cancel As Integer) - -If Not IsNull(TFusstext.Value) And TFusstext.Value <> "" Then - - SetParameter "AUSZAHLUNGTEXT", TFusstext.Value -Else - SetParameter "AUSZAHLUNGTEXT", " " -End If - - -End Sub - -Private Sub TGBZS_Exit(Cancel As Integer) - -MsgBox ("Für gebundene und ungebundene Lieferungen gibt es auch unterschiedliche Sortentabellen pro Oechsle. Unterschiede zwischen gebundenen und ungebundenen Auszahlungen sollten daher in die Sortentabellen eingebracht werden. Das Feld 'Gebunden-Zuschlag' einer Auszahlung ist daher grundsätzlich obsolet, wird aber aus Kompatibilitätsgründen weiterhin bei der Berechnung berücksichtigt.") - -End Sub - -Private Sub TGebunden_Click() - -FUnter1.Requery - -End Sub - -Private Sub TGebunden_Exit(Cancel As Integer) - -FUnter1.Requery - -End Sub - -Private Sub TSANR_Click() - -If Not IsNull(TSANR) Then - FUnter1.Form.RecordSource = "SELECT * FROM TAuszahlungSorten WHERE TAuszahlungSorten.SNR=[Forms]![FAuszahlung]![TSNR] AND TAuszahlungSorten.gebunden=[Forms]![FAuszahlung]![TGebunden] AND TAuszahlungSorten.SANR=[Forms]![FAuszahlung]![TSANR] ORDER BY TAuszahlungSorten.Oechsle" -Else - FUnter1.Form.RecordSource = "SELECT * FROM TAuszahlungSorten WHERE TAuszahlungSorten.SNR=[Forms]![FAuszahlung]![TSNR] AND TAuszahlungSorten.gebunden=[Forms]![FAuszahlung]![TGebunden] AND TAuszahlungSorten.SANR IS NULL ORDER BY TAuszahlungSorten.Oechsle" -End If - FUnter1.Requery - -End Sub - -Private Sub TSNR_Click() - -FUnter1.Requery - -End Sub - -Private Sub TSNR_Exit(Cancel As Integer) - -FUnter1.Requery - -End Sub - -Private Sub TTraubengutschriftNummerVon_Exit(Cancel As Integer) - -BerechneLetzteNummer - -End Sub - -Private Sub TZahlungNr_Change() - - Dim str1 As String - Dim str2 As String - - Select Case Forms!FAuszahlung!TZahlungNr - - Case 1: - If DSum("BTeilzahlung1", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 1.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Forms!FAuszahlung!TZahlungNr = 7 - End If - End If - Case 2: - If DSum("BTeilzahlung2", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 2.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Forms!FAuszahlung!TZahlungNr = 7 - End If - End If - Case 3: - If DSum("BTeilzahlung3", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 3.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Forms!FAuszahlung!TZahlungNr = 7 - End If - End If - Case 4: - If DSum("BTeilzahlung4", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine 4.Teilzahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Forms!FAuszahlung!TZahlungNr = 7 - End If - End If - Case 5: - If DSum("BTeilzahlung5", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine frei definierbare Zahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Forms!FAuszahlung!TZahlungNr = 7 - End If - End If - If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then - str1 = "" - Else - str1 = GetParameter("FREIERAUSZAHLUNGSTITEL") - str2 = "" - End If - While str2 = "" - str2 = InputBox("Bitte geben Sie den freien Auszahlungstitel ein:", "FREIER TITEL", str1) - Wend - SetParameter "FREIERAUSZAHLUNGSTITEL", str2 - Case 6: - If DSum("BEndauszahlung", "TLieferungen", "Year(Datum)=" + Format(TLesejahr)) Then - If MsgBox("Es wurde für dieses Lesejahr bereits eine Endauszahlung berechnet ! Fortfahren ?", vbYesNo) = vbNo Then - Forms!FAuszahlung!TZahlungNr = 7 - End If - End If - End Select - -End Sub - -Private Sub TZahlungNr_Exit(Cancel As Integer) - -If TZahlungNr.Value = 6 Then - OEndauszahlung = True -Else - OEndauszahlung = False -End If - - -End Sub -Private Sub Befehl283_Click() - -Dim query As String - - -'DoCmd.OpenReport "BAuszahlungsvariante", acViewPreview -DoCmd.OpenQuery "AAuszahlungsvarianten" -DoCmd.Maximize -DoCmd.OpenReport "BAuszahlungsvarianteKopf", acViewPreview - - -End Sub - -Sub ErgebnisfelderLoeschen() - -TErgebnisBetrag = "" -TErgebnisGewicht = "" -TErgebnisGebunden = "" -TErgebnisDatensaetze = "" - - -End Sub - - -Function RundenAlt(Wert As Double, KommaStellen As Integer) As Double - -Dim t1 As Double - -t1 = CLng(Wert * 10 ^ KommaStellen) / 10 ^ KommaStellen -'t1 = Round(Wert, KommaStellen) - -RundenAlt = t1 - -End Function - - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function - - - - -Function GetAbschlägeAsString(LINR1 As Long) As String - Const separator = " / " - Const separator_length = 3 - Dim db1 As Database - Dim rs1 As Recordset - Dim resultString As String - Set db1 = CurrentDb - - Set rs1 = db1.OpenRecordset("SELECT TAbschlaege.* FROM (TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR) INNER JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE TLieferungen.LINR=" + Format(LINR1)) - - resultString = "" - While Not rs1.EOF - resultString = resultString + separator + rs1!Bezeichnung - rs1.MoveNext - Wend - rs1.Close - If resultString <> "" Then resultString = Mid(resultString, 1 + separator_length) - - GetAbschlägeAsString = resultString - -End Function diff --git a/wgmaster/vba/form/Form_FAuszahlungParameter.frm b/wgmaster/vba/form/Form_FAuszahlungParameter.frm deleted file mode 100644 index 1bb668b..0000000 --- a/wgmaster/vba/form/Form_FAuszahlungParameter.frm +++ /dev/null @@ -1,166 +0,0 @@ -Option Compare Database -Option Explicit - - - -Private Sub BOk_Click() - -Dim a(0 To 5) As Double -Dim g(0 To 5) As Double -Dim o(0 To 5) As Double -Dim i As Integer - -Dim aznr1 As Long -Dim QSNR1 As Long -Dim SNR1 As String -Dim SANR1 As String -Dim start1 As Long -Dim gebunden1 As Integer -Dim maxreihe As Integer -Dim Oechsle1 As Long - -Dim db1 As Database -Dim rs1 As Recordset - -aznr1 = Forms!FAuszahlung!TAZNR -SNR1 = Forms!FAuszahlung!TSNR -gebunden1 = Forms!FAuszahlung!TGebunden -If IsNull(Forms!FAuszahlung!TSANR) Then - SANR1 = "NULL" -Else - SANR1 = "'" + Forms!FAuszahlung!TSANR + "'" -End If - -maxreihe = 0 - -If Not IsNull(TO1) Then - o(1) = TO1 - a(1) = TA1 - g(1) = TG1 - maxreihe = 1 -End If - -If Not IsNull(TO2) Then - o(2) = TO2 - a(2) = TA2 - g(2) = TG2 - maxreihe = 2 -End If - -If Not IsNull(TO3) Then - o(3) = TO3 - a(3) = TA3 - g(3) = TG3 - maxreihe = 3 -End If - -If Not IsNull(TO4) Then - o(4) = TO4 - a(4) = TA4 - g(4) = TG4 - maxreihe = 4 -End If - -If Not IsNull(TO5) Then - o(5) = TO5 - a(5) = TA5 - g(5) = TG5 - maxreihe = 5 -End If - -If maxreihe = 0 Then - MsgBox "Sie müssen zumindest die Parameter für Reihe 1 eingeben!", vbCritical - Exit Sub - -End If - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(aznr1) + " AND SNR='" + Format(SNR1) + "' AND Gebunden=" + Format(gebunden1) + " AND SANR=" + SANR1) - -While Not rs1.EOF - - rs1.Edit - - Oechsle1 = rs1!Oechsle - - i = maxreihe - While i > 0 And Oechsle1 < o(i) - i = i - 1 - Wend - - If i > 0 Then - rs1!Betrag = g(i) + (Oechsle1 - o(i)) * a(i) - Else - rs1!Betrag = 0 - End If - - rs1.Update - rs1.MoveNext - -Wend -rs1.Close - -'Parameter sichern -If Not IsNull(TO1) Then SetParameter "AuszahlungParameterReihe1OechsleStart", TO1 -If Not IsNull(TO2) Then SetParameter "AuszahlungParameterReihe2OechsleStart", TO2 -If Not IsNull(TO3) Then SetParameter "AuszahlungParameterReihe3OechsleStart", TO3 -If Not IsNull(TO4) Then SetParameter "AuszahlungParameterReihe4OechsleStart", TO4 -If Not IsNull(TO5) Then SetParameter "AuszahlungParameterReihe5OechsleStart", TO5 - -If Not IsNull(TG1) Then SetParameter "AuszahlungParameterReihe1Grundwert", TG1 -If Not IsNull(TG2) Then SetParameter "AuszahlungParameterReihe2Grundwert", TG2 -If Not IsNull(TG3) Then SetParameter "AuszahlungParameterReihe3Grundwert", TG3 -If Not IsNull(TG4) Then SetParameter "AuszahlungParameterReihe4Grundwert", TG4 -If Not IsNull(TG5) Then SetParameter "AuszahlungParameterReihe5Grundwert", TG5 - -If Not IsNull(TA1) Then SetParameter "AuszahlungParameterReihe1Anstieg", TA1 -If Not IsNull(TA2) Then SetParameter "AuszahlungParameterReihe2Anstieg", TA2 -If Not IsNull(TA3) Then SetParameter "AuszahlungParameterReihe3Anstieg", TA3 -If Not IsNull(TA4) Then SetParameter "AuszahlungParameterReihe4Anstieg", TA4 -If Not IsNull(TA5) Then SetParameter "AuszahlungParameterReihe5Anstieg", TA5 - -DoCmd.Close -Forms!FAuszahlung!FUnter1.Requery - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -Dim v - -v = GetParameter("AuszahlungParameterReihe1OechsleStart") -If Not IsNull(v) Then TO1 = v -v = GetParameter("AuszahlungParameterReihe2OechsleStart") -If Not IsNull(v) Then TO2 = v -v = GetParameter("AuszahlungParameterReihe3OechsleStart") -If Not IsNull(v) Then TO3 = v -v = GetParameter("AuszahlungParameterReihe4OechsleStart") -If Not IsNull(v) Then TO4 = v -v = GetParameter("AuszahlungParameterReihe5OechsleStart") -If Not IsNull(v) Then TO5 = v - -v = GetParameter("AuszahlungParameterReihe1Grundwert") -If Not IsNull(v) Then TG1 = v -v = GetParameter("AuszahlungParameterReihe2Grundwert") -If Not IsNull(v) Then TG2 = v -v = GetParameter("AuszahlungParameterReihe3Grundwert") -If Not IsNull(v) Then TG3 = v -v = GetParameter("AuszahlungParameterReihe4Grundwert") -If Not IsNull(v) Then TG4 = v -v = GetParameter("AuszahlungParameterReihe5Grundwert") -If Not IsNull(v) Then TG5 = v - -v = GetParameter("AuszahlungParameterReihe1Anstieg") -If Not IsNull(v) Then TA1 = v -v = GetParameter("AuszahlungParameterReihe2Anstieg") -If Not IsNull(v) Then TA2 = v -v = GetParameter("AuszahlungParameterReihe3Anstieg") -If Not IsNull(v) Then TA3 = v -v = GetParameter("AuszahlungParameterReihe4Anstieg") -If Not IsNull(v) Then TA4 = v -v = GetParameter("AuszahlungParameterReihe5Anstieg") -If Not IsNull(v) Then TA5 = v - - -End Sub diff --git a/wgmaster/vba/form/Form_FAuszahlungSorten.frm b/wgmaster/vba/form/Form_FAuszahlungSorten.frm deleted file mode 100644 index 7a1fbaa..0000000 --- a/wgmaster/vba/form/Form_FAuszahlungSorten.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BBewirtschaftungsarten" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FAuszahlungSortenAuswahl.frm b/wgmaster/vba/form/Form_FAuszahlungSortenAuswahl.frm deleted file mode 100644 index 509d486..0000000 --- a/wgmaster/vba/form/Form_FAuszahlungSortenAuswahl.frm +++ /dev/null @@ -1,108 +0,0 @@ -Option Compare Database -Option Explicit - - - - - -Private Sub Befehl51_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - -Dim aznr1 As Long ' the actual AZNR -Dim SNR1 As String ' actual snr -Dim SANR1 As String -Dim SNR2 As String -Dim SANR2 As String - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim i As Long -Dim gebunden1 As Integer -Dim gebunden2 As Integer -Dim varElement As Variant - - -If MsgBox("Wollen Sie die eingegebene Sortentabelle auf die ausgewählten Sorten kopieren ?", vbYesNo) = vbYes Then - -DoCmd.Hourglass True - aznr1 = Forms!FAuszahlung!TAZNR - SNR1 = Forms!FAuszahlung!TSNR - gebunden1 = Forms!FAuszahlung!TGebunden - If IsNull(Forms!FAuszahlung!TSANR) Then - SANR1 = "" - Else - SANR1 = Forms!FAuszahlung!TSANR - End If - - -Set db1 = CurrentDb - - -'For Each varElement In LSorten.ItemsSelected -For i = 0 To LSorten.ListCount - 1 - - If LSorten.Selected(i) Then - - LSorten.BoundColumn = 1 - SNR2 = LSorten.ItemData(i) - LSorten.BoundColumn = 5 - If IsNull(LSorten.ItemData(i)) Then - SANR2 = "" - Else - SANR2 = LSorten.ItemData(i) - End If - LSorten.BoundColumn = 4 - If LSorten.ItemData(i) = "gebunden" Then - gebunden2 = True - Else - gebunden2 = False - End If - - 'MsgBox (SNR2) - - If SANR1 = "" Then - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR1 + "' AND Gebunden=" + Format(gebunden1) + " AND SANR IS NULL ORDER BY Oechsle") - Else - Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR1 + "' AND Gebunden=" + Format(gebunden1) + " AND SANR='" + SANR1 + "' ORDER BY Oechsle") - End If - If SANR2 = "" Then - Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR2 + "' AND Gebunden=" + Format(gebunden2) + " AND SANR IS NULL ORDER BY Oechsle") - Else - Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR2 + "' AND Gebunden=" + Format(gebunden2) + " AND SANR='" + SANR2 + "' ORDER BY Oechsle") - End If - - While Not rs1.EOF - - - rs2.Edit - rs2!Betrag = rs1!Betrag - rs2.Update - - - rs2.MoveNext - rs1.MoveNext - - Wend - - rs1.Close - rs2.Close - - End If - -'Next varElement -Next i - -DoCmd.Hourglass False - -End If - -DoCmd.Close -Forms!FAuszahlung!FUnter1.Requery - -End Sub diff --git a/wgmaster/vba/form/Form_FAuszahlungSortenQualitätsstufe.frm b/wgmaster/vba/form/Form_FAuszahlungSortenQualitätsstufe.frm deleted file mode 100644 index 7a1fbaa..0000000 --- a/wgmaster/vba/form/Form_FAuszahlungSortenQualitätsstufe.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BBewirtschaftungsarten" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FBanken.frm b/wgmaster/vba/form/Form_FBanken.frm deleted file mode 100644 index 8603c41..0000000 --- a/wgmaster/vba/form/Form_FBanken.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BBanken" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FBewirtschaftungsarten.frm b/wgmaster/vba/form/Form_FBewirtschaftungsarten.frm deleted file mode 100644 index 7a1fbaa..0000000 --- a/wgmaster/vba/form/Form_FBewirtschaftungsarten.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BBewirtschaftungsarten" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FChargeUmfuellen.frm b/wgmaster/vba/form/Form_FChargeUmfuellen.frm deleted file mode 100644 index cf45628..0000000 --- a/wgmaster/vba/form/Form_FChargeUmfuellen.frm +++ /dev/null @@ -1,179 +0,0 @@ - -Dim lastCNR - - - -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 BUmfuellen_Click() - -Dim CNR1 As Long - -Select Case XUmfuellenOption - -Case 1: 'vorhandene - - ChargeUmfuellen Forms("MChargenAuswahl")!LChargen, LChargen, TMenge, OMengeZuruecksetzen, OOechsleZuruecksetzen, OStatusEntleert - -Case 2: 'neue - CNR1 = ChargeClonen(Forms("MChargenAuswahl")!LChargen, TBNR, 0, 0) - ChargeUmfuellen Forms("MChargenAuswahl")!LChargen, CNR1, TMenge, OMengeZuruecksetzen, OOechsleZuruecksetzen, OStatusEntleert - -End Select - -DoCmd.Close - -End Sub - -Private Sub Form_Activate() - -RefreshAll - -End Sub - -Private Sub Form_Load() - -OMengeZuruecksetzen = True -OOechsleZuruecksetzen = True -OStatusEntleert = True - -If Month(Date) < 9 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If - -lastCNR = -1 - -TMenge = DFirst("Menge", "TChargen", "CNR=Forms!MChargenAuswahl!LChargen") - - - -XUmfuellenOption = 1 - -RefreshAll - - - -End Sub - -Private Sub LChargen_DblClick(Cancel As Integer) - -lastCNR = LChargen - -ChargeUmfuellen Forms("MChargenAuswahl")!LChargen, LChargen, TMenge, OMengeZuruecksetzen, OOechsleZuruecksetzen, OStatusEntleert -DoCmd.Close - -End Sub - -Private Sub TLesejahr_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Function GetFilter() As String - -Dim filter1 - -filter1 = "Jahrgang=" + Format(TLesejahr) - -filter1 = filter1 + " AND TChargen.CSNR=2" -filter1 = filter1 + " AND TChargen.CNR<>" + Format(Forms("MChargenAuswahl")!LChargen) - -If Not IsNull(TZNR) Then - filter1 = filter1 + " AND TChargen.ZNR=" + TZNR -End If - -GetFilter = filter1 - -End Function - -Function GetOrder() As String - - GetOrder = " ORDER BY BefuellungsBeginn" - -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 XUmfuellenOption_Click() - -Select Case XUmfuellenOption - -Case 1: 'vorhandene -LChargen.Visible = True -TLesejahr.Visible = True -TZNR.Visible = True -BJahrZurueck.Visible = True -BJahrWeiter.Visible = True -TBNR.Visible = False -LBehaelter.Visible = False - -Case 2: 'neue -TBNR.Visible = True -LChargen.Visible = False -TLesejahr.Visible = False -TZNR.Visible = False -BJahrZurueck.Visible = False -BJahrWeiter.Visible = False -LBehaelter.Visible = True - - -End Select - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FChargen.frm b/wgmaster/vba/form/Form_FChargen.frm deleted file mode 100644 index 74c79da..0000000 --- a/wgmaster/vba/form/Form_FChargen.frm +++ /dev/null @@ -1,70 +0,0 @@ -Private Sub BBefüllungBeenden_Click() - -ChargeBefuellungBeenden (TCNR) - -End Sub - -Private Sub BBefüllungStarten_Click() - -ChargeBefuellungStarten (TCNR) - -End Sub - -Private Sub BChargenstammblatt_Click() - -DoCmd.OpenReport "BChargenStammblatt", acViewPreview, , "CNR=" + Format(TCNR) - -End Sub - -Private Sub BUmfuellen_Click() - -DoCmd.OpenForm "FChargeUmfuellen" - -End Sub - -Private Sub Form_Current() - -LLieferungen.Requery -LChargenVorgaenger.Requery -LChargenNachfolger.Requery - -End Sub - -Private Sub LChargenNachfolger_DblClick(Cancel As Integer) - -filter = "CNR=" + Format(LChargenNachfolger) -FilterOn = True - -End Sub - -Private Sub LChargenVorgaenger_DblClick(Cancel As Integer) - -filter = "CNR=" + Format(LChargenVorgaenger) -FilterOn = True - - -End Sub - -Private Sub TBNR_Exit(Cancel As Integer) - -RefreshChargennummer - -End Sub - -Sub RefreshChargennummer() - -Dim Maxcounter1 As Long -'MsgBox (TChargennummer) -If IsNull(TChargennummer) And TBNR > 0 Then - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - TChargennummer = GeneriereChargennummer(TCNR, Maxcounter1) - TChargennummerZaehler = Maxcounter1 -End If - -End Sub - -Private Sub TChargennummer_Exit(Cancel As Integer) - -RefreshChargennummer - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FFlaechenbindungen.frm b/wgmaster/vba/form/Form_FFlaechenbindungen.frm deleted file mode 100644 index 641988e..0000000 --- a/wgmaster/vba/form/Form_FFlaechenbindungen.frm +++ /dev/null @@ -1,24 +0,0 @@ -Private Sub BNeuerNied_Click() - -If IsNull(LGNR) Then - MsgBox "Bitte zuerst Gemeinde auswählen !", vbCritical -Else - DoCmd.OpenForm ("FRiedeMitglied") -End If - - -End Sub - -Private Sub LRiede_GotFocus() -query1 = "SELECT RNR, BEZEICHNUNG FROM TRiede WHERE GNR=" + Format(LGNR) + " order by BEZEICHNUNG " -LRiede.RowSource = query1 -LRiede.Requery - -End Sub - -Private Sub LRiede_LostFocus() -query1 = "SELECT RNR, BEZEICHNUNG FROM TRiede order by BEZEICHNUNG;" -LRiede.RowSource = query1 -LRiede.Requery - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FGebiete.frm b/wgmaster/vba/form/Form_FGebiete.frm deleted file mode 100644 index c783e28..0000000 --- a/wgmaster/vba/form/Form_FGebiete.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Form_Close() - -RefreshMain - -End Sub - -Private Sub TBezeichnung_Exit(Cancel As Integer) - -RefreshMain - -End Sub - -Sub RefreshMain() - -Dim gebietsnr As Long - -gebietsnr = CLng(Forms!FGebiete!TWBGNR) - -Forms!FGebietshierarchie.InitGebiete -Forms!FGebietshierarchie!LGebiete = gebietsnr -Forms!FGebietshierarchie.InitGrosslagen - -End Sub - diff --git a/wgmaster/vba/form/Form_FGebietshierarchie.frm b/wgmaster/vba/form/Form_FGebietshierarchie.frm deleted file mode 100644 index 3dfc8a6..0000000 --- a/wgmaster/vba/form/Form_FGebietshierarchie.frm +++ /dev/null @@ -1,345 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub BGebietBearbeiten_Click() - -DoCmd.OpenForm "FGebiete", acNormal, , "WBGNR=" + Format(LGebiete.Value), acFormEdit - -End Sub - -Private Sub BGebietLoeschen_Click() - -If MsgBox("Sind Sie sicher, daß Sie dieses Gebiet löschen wollen ?", vbYesNo) = vbYes Then - - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM TGebiete WHERE WBGNR=" + Format(Forms!FGebietshierarchie!LGebiete) + ";") - -rs1.MoveFirst -rs1.Delete -rs1.Close - -LGebiete.SetFocus -InitGebiete - - -End If - - -End Sub - -Private Sub BGebietNeu_Click() - -DoCmd.OpenForm "FGebiete", acNormal, , "RNR=" + Format(LRegionen.Value), acFormAdd - -End Sub - -Private Sub BGemeindeBearbeiten_Click() - -DoCmd.OpenForm "FGemeinden", acNormal, , "GNR=" + Format(LGemeinden.Value), acFormEdit - -End Sub - -Private Sub BGemeindeLoeschen_Click() - -If MsgBox("Sind Sie sicher, daß Sie diese Gemeinde löschen wollen ?", vbYesNo) = vbYes Then - - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM TGemeinden WHERE GNR=" + Format(Forms!FGebietshierarchie!LGemeinden) + ";") - -rs1.MoveFirst -rs1.Delete -rs1.Close - -LGemeinden.SetFocus -InitGemeinden - -End If - - - -End Sub - -Private Sub BGemeindeNeu_Click() - -DoCmd.OpenForm "FGemeinden", acNormal, , "GLNR=" + Format(LGrosslagen.Value), acFormAdd - -End Sub - -Private Sub BGrosslageBearbeiten_Click() - -DoCmd.OpenForm "FGrosslagen", acNormal, , "GLNR=" + Format(LGrosslagen.Value), acFormEdit - -End Sub - -Private Sub BGrosslageLoeschen_Click() - -If MsgBox("Sind Sie sicher, daß Sie diese Großlage löschen wollen ?", vbYesNo) = vbYes Then - - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM TGrosslagen WHERE GLNR=" + Format(Forms!FGebietshierarchie!LGrosslagen) + ";") - -rs1.MoveFirst -rs1.Delete -rs1.Close - -LGrosslagen.SetFocus -InitGrosslagen - - -End If - - - -End Sub - -Private Sub BGrosslageNeu_Click() - -DoCmd.OpenForm "FGrosslagen", acNormal, , "WBGNR=" + Format(LGebiete.Value), acFormAdd - -End Sub - -Private Sub BRegionBearbeiten_Click() - -DoCmd.OpenForm "FRegionen", acNormal, , "RGNR=" + Format(LRegionen.Value), acFormEdit - -End Sub - -Private Sub BRegionLoeschen_Click() - -If MsgBox("Sind Sie sicher, daß Sie diese Region löschen wollen ?", vbYesNo) = vbYes Then - - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM TRegionen WHERE RGNR=" + Format(Forms!FGebietshierarchie!LRegionen) + ";") - -rs1.MoveFirst -rs1.Delete -rs1.Close - -LRegionen.SetFocus -InitRegionen - - -End If - - -End Sub - -Private Sub BRegionNeu_Click() - -DoCmd.OpenForm "FRegionen", acNormal, , , acFormAdd - -End Sub - -Private Sub BRiedBearbeiten_Click() - -DoCmd.OpenForm "FRiede", acNormal, , "RNR=" + Format(LRiede.Value), acFormEdit - -End Sub - -Private Sub BRiedLoeschen_Click() - -If MsgBox("Sind Sie sicher, daß Sie diesen Ried löschen wollen ?", vbYesNo) = vbYes Then - - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * FROM TRiede WHERE RNR=" + Format(Forms!FGebietshierarchie!LRiede) + ";") - -rs1.MoveFirst -rs1.Delete -rs1.Close - -LRiede.SetFocus -InitRiede - -End If - - -End Sub - -Private Sub BRiedNeu_Click() - -DoCmd.OpenForm "FRiede", acNormal, , "GNR=" + Format(LGemeinden.Value), acFormAdd - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -InitRegionen - -End Sub - - -Sub InitRegionen() - -'LRegionen.SetFocus -BRegionNeu.Visible = True -BRegionLoeschen.Visible = True -BRegionBearbeiten.Visible = True - -LRegionen.Requery -If LRegionen.ListCount > 0 Then - LRegionen = LRegionen.ItemData(0) - BGebietNeu.Visible = True - BRegionLoeschen.Visible = True - BRegionBearbeiten.Visible = True -Else - LRegionen = -1 - BRegionLoeschen.Visible = False - BRegionBearbeiten.Visible = False - BGebietNeu.Visible = False - BGebietBearbeiten.Visible = False - BGebietLoeschen.Visible = False -End If - -InitGebiete - -End Sub - -Sub InitGebiete() - - -LGebiete.Requery -'LGebiete.SetFocus -If LGebiete.ListCount > 0 Then - LGebiete = LGebiete.ItemData(0) - BGebietBearbeiten.Visible = True - BGebietLoeschen.Visible = True - BGrosslageNeu.Visible = True -Else - LGebiete = -1 - BGebietLoeschen.Visible = False - BGebietBearbeiten.Visible = False - BGrosslageNeu.Visible = False - BGrosslageLoeschen.Visible = False - BGrosslageBearbeiten.Visible = False -End If - -InitGrosslagen - -End Sub - -Sub InitGrosslagen() - -LGrosslagen.Requery -'LGrosslagen.SetFocus -If LGrosslagen.ListCount > 0 Then - LGrosslagen = LGrosslagen.ItemData(0) - BGrosslageLoeschen.Visible = True - BGrosslageBearbeiten.Visible = True - BGemeindeNeu.Visible = True -Else - LGrosslagen = -1 - BGrosslageLoeschen.Visible = False - BGrosslageBearbeiten.Visible = False - BGemeindeNeu.Visible = False - BGemeindeLoeschen.Visible = False - BGemeindeBearbeiten.Visible = False -End If - -InitGemeinden - -End Sub - -Sub InitGemeinden() - -'LGemeinden.SetFocus -LGemeinden.Requery - -If LGemeinden.ListCount > 0 Then - LGemeinden = LGemeinden.ItemData(0) - BGemeindeLoeschen.Visible = True - BGemeindeBearbeiten.Visible = True - BRiedNeu.Visible = True -Else - LGemeinden = -1 - BGemeindeLoeschen.Visible = False - BGemeindeBearbeiten.Visible = False - BRiedNeu.Visible = False - BRiedLoeschen.Visible = False - BRiedBearbeiten.Visible = False -End If - -InitRiede - -End Sub - -Sub InitRiede() - -LRiede.Requery -'LRiede.SetFocus - -If LRiede.ListCount > 0 Then - LRiede = LRiede.ItemData(0) - BRiedLoeschen.Visible = True - BRiedBearbeiten.Visible = True -Else - LRiede = -1 - BRiedLoeschen.Visible = False - BRiedBearbeiten.Visible = False -End If - -End Sub - -Private Sub LGebiete_Click() - -InitGrosslagen - -End Sub - -Private Sub LGemeinden_Click() - -InitRiede - -End Sub - -Private Sub LGrosslagen_Click() - -InitGemeinden - -End Sub - -Private Sub LRegionen_Click() - -InitGebiete - -End Sub -Private Sub Befehl34_Click() -On Error GoTo Err_Befehl34_Click - - Dim stDocName As String - - stDocName = "BGebietshierarchie" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl34_Click: - Exit Sub - -Err_Befehl34_Click: - MsgBox Err.Description - Resume Exit_Befehl34_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FGemeinden.frm b/wgmaster/vba/form/Form_FGemeinden.frm deleted file mode 100644 index b16753f..0000000 --- a/wgmaster/vba/form/Form_FGemeinden.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Form_Close() - -RefreshMain - -End Sub - -Private Sub TBezeichnung_Exit(Cancel As Integer) - -RefreshMain - -End Sub - -Sub RefreshMain() - -Dim GNR As Long - -GNR = CLng(Forms!FGemeinden!TGNR) - -Forms!FGebietshierarchie.InitGemeinden -Forms!FGebietshierarchie!LGemeinden = GNR -Forms!FGebietshierarchie.InitRiede - -End Sub - diff --git a/wgmaster/vba/form/Form_FGrosslagen.frm b/wgmaster/vba/form/Form_FGrosslagen.frm deleted file mode 100644 index 1f790ae..0000000 --- a/wgmaster/vba/form/Form_FGrosslagen.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Form_Close() - -RefreshMain - -End Sub - -Private Sub TBezeichnung_Exit(Cancel As Integer) - -RefreshMain - -End Sub - -Sub RefreshMain() - -Dim GLNR As Long - -GLNR = CLng(Forms!FGrosslagen!TGLNR) - -Forms!FGebietshierarchie.InitGrosslagen -Forms!FGebietshierarchie!LGrosslagen = GLNR -Forms!FGebietshierarchie.InitGemeinden - -End Sub - diff --git a/wgmaster/vba/form/Form_FLeseplanung.frm b/wgmaster/vba/form/Form_FLeseplanung.frm deleted file mode 100644 index 4a7601b..0000000 --- a/wgmaster/vba/form/Form_FLeseplanung.frm +++ /dev/null @@ -1,52 +0,0 @@ -Public Lesejahr As Integer - - -Public Function GetLesejahr() - -GetLesejahr = Lesejahr - -End Function - -Public Sub SetLesejahr(Jahr1 As Integer) - Lesejahr = Jahr1 - -End Sub - -Private Sub BLeseplanungDrucken_Click() - - -DoCmd.OpenReport "BLeseplanung", acPreview, , "Year(Datum)=" + Format(Lesejahr) - -End Sub - -Private Sub TSNR_Exit(Cancel As Integer) - - TSNR = UCase(TSNR) - - Dim SNR1 As String - Dim SANR1 As String - - - If IsNull(TSNR) Then - Exit Sub - End If - - If GetSNRAndSANRFromInput(TSNR, SNR1, SANR1) Then - TSNR = SNR1 - TSANR = SANR1 - Else - TSANR = Null - End If - - - If DCount("[SNR]", "TSorten", "SNR='" + TSNR + "'") = 0 Then - MsgBox "Bitte geben Sie ein gültiges Sortenkürzel ein!", vbCritical - 'TSNR = - TSNR.SetFocus - Exit Sub - End If - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FLiefermengen.frm b/wgmaster/vba/form/Form_FLiefermengen.frm deleted file mode 100644 index 0e88bf7..0000000 --- a/wgmaster/vba/form/Form_FLiefermengen.frm +++ /dev/null @@ -1,69 +0,0 @@ - -Private Sub BSortenKuerzelUmbenennen_Click() - -DoCmd.OpenForm "FSortenkuerzelUmbenennen" - -End Sub - -Private Sub BAutomatischErstellen_Click() - -If MsgBox("Wollen Sie Liefermengeneinträge aufgrund der vorhandenen Flächenbindungen automatisch erstellen?", vbYesNo) = vbYes Then - - Dim db1 As Database - Dim rs1 As Recordset - Dim rs2 As Recordset - Dim query1 As String - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNR,SANR FROM TFlaechenbindungen WHERE SNR IS NOT NULL AND (Bis>" + Format(year(Date)) + " OR Bis is null)") - While Not rs1.EOF - If IsNull(rs1("SANR")) Then - query1 = "SELECT * FROM TLiefermengen WHERE SNR='" + rs1("SNR") + "' AND SANR IS NULL" - Else - query1 = "SELECT * FROM TLiefermengen WHERE SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'" - End If - - Set rs2 = db1.OpenRecordset(query1) - - If rs2.EOF Then - 'there is no entry for this combination - rs2.AddNew - rs2("SNR") = rs1("SNR") - rs2("SANR") = rs1("SANR") - rs2("ErwarteteLiefermengeProHa") = 7500 - rs2.Update - End If - - rs1.MoveNext - Wend - - rs1.Close - rs2.Close - Requery - - -End If - -End Sub - -Private Sub Form_Close() - -If Not IsNull(TKopftext) Then SetParameter "LIEFERMENGEKOPFTEXT", TKopftext -If Not IsNull(TFusstext) Then SetParameter "LIEFERMENGEFUSSTEXT", TFusstext - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -If Not IsNull(GetParameter("LIEFERMENGEKOPFTEXT")) Then - TKopftext = GetParameter("LIEFERMENGEKOPFTEXT") -Else - TKopftext = "Auf Grund der Flächenbindung erwartet der Winzerkeller im Weinviertel reg.Gen.m.b.H. bei der Ernte 2014 von Ihnen eine Lieferung von mindestens" -End If - -If Not IsNull(GetParameter("LIEFERMENGEKOPFTEXT")) Then - TFusstext = GetParameter("LIEFERMENGEFUSSTEXT") -Else - TFusstext = "Bei Nichterfüllung muss mit der im Vertrag vereinbarten Pönnaleforderung gerechnet werden." -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FLieferungAbschlag.frm b/wgmaster/vba/form/Form_FLieferungAbschlag.frm deleted file mode 100644 index 9e0f5ef..0000000 --- a/wgmaster/vba/form/Form_FLieferungAbschlag.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BAbschlaege" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FLieferungen.frm b/wgmaster/vba/form/Form_FLieferungen.frm deleted file mode 100644 index 84646ca..0000000 --- a/wgmaster/vba/form/Form_FLieferungen.frm +++ /dev/null @@ -1,718 +0,0 @@ -Public TheEvent As Integer - -Dim CNRAlt As Long - - -Private Sub BAbwerten_Click() - - -Dim wert1 -Dim Wert As Double -Dim aktLieferscheinnummer -Dim db1 As Database - -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim rs3 As Recordset -Dim rs4 As Recordset - -aktLieferscheinnummer = TLieferscheinnummer - -If OAbgewertet = True Then - MsgBox "Dieser Lieferschein wurde bereits abgewertet !", vbCritical - Exit Sub -End If - -If OStorniert = True Then - MsgBox "Ein stornierter Lieferschein kann nicht abgewertet werden !", vbCritical - Exit Sub -End If - -'If TOechsle < CLng(GetParameter("ABWERTUNGOECHSLE")) Then -' MsgBox "Die Abwertung macht keinen Sinn, da Oechsle bereits niedriger", vbCritical -' Exit Sub -'End If - -wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?") - -If IsNull(wert1) Or wert1 = "" Then - MsgBox "Sie haben kein gültiges Gewicht eingegeben - Abwertung abgebrochen !", vbCritical - Exit Sub -End If - -If wert1 > 0 Then - Wert = wert1 - If Wert >= TGewicht Then - MsgBox ("Gesamte Lieferung abwerten") - OAbgewertet = True - TOechsleOriginal = TOechsle - TQSNROriginal = TQSNR - 'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt - 'If Not IsNull(TSANR) And TSANR <> "" Then - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then - ' 'Keine Oechslereduktion - ' Else - ' TOechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'Else - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then - ' 'Keine Oechslereduktion - ' Else - ' TOechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'End If - - TLieferscheinnummer = TLieferscheinnummer + "A" - 'TQSNR = 1 - 'CP 20.11.2011: Änderung auf Qualitätsstufe 5 = 'Wein - TQSNR = 0 - - Else - MsgBox ("Teil der Lieferung abwerten - Neuen Lieferschein erstellen") - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("TLieferungen") - Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(TLINR)) - rs1.AddNew - - rs1!MGNR = rs2!MGNR - rs1!GNR = rs2!GNR - rs1!RNR = rs2!RNR - - rs1!ZNR = rs2!ZNR - rs1!SNR = rs2!SNR - If Not IsNull(rs2!SANR) Then - rs1!SANR = rs2!SANR - End If - rs1!Lieferscheinnummer = rs2!Lieferscheinnummer + "A" - rs1!Datum = rs2!Datum - rs1!Uhrzeit = rs2!Uhrzeit - rs1!Anmerkung = rs2!Anmerkung - rs1!Gerebelt = rs2!Gerebelt - - rs1!LINR = DMax("LINR", "TLieferungen") + 1 - rs1!OechsleOriginal = rs2!Oechsle - rs1!Oechsle = rs2!Oechsle - - 'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt - 'If Not IsNull(TSANR) And TSANR <> "" Then - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then - ' 'Keine Oechslereduktion - ' rs1!Oechsle = rs2!Oechsle - ' Else - ' rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'Else - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then - ' 'Keine Oechslereduktion - ' rs1!Oechsle = rs2!Oechsle - ' Else - ' rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'End If - - rs1!Abgewertet = True - rs1!Gewicht = Wert - rs1!QSNROriginal = rs2!QSNR - rs1!QSNR = 0 - 'TQSNR = 1 - 'CP 20.11.2011: Änderung auf Qualitätsstufe 5 = 'Wein - 'TQSNR = 0 - rs1!Handwiegung = False - rs1!Storniert = False - - 'Abschläge kopieren - Set rs3 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE LINR=" + Format(TLINR)) - Set rs4 = db1.OpenRecordset("TLieferungAbschlag") - While Not rs3.EOF - rs4.AddNew - rs4!LINR = rs1!LINR - rs4!ASNR = rs3!ASNR - rs4.Update - rs3.MoveNext - Wend - rs3.Close - rs4.Close - - rs1.Update - rs1.Close - rs2.Close - TGewicht = TGewicht - Wert - End If -End If - -Requery -TLieferscheinnummer.SetFocus -'DoCmd.FindRecord aktLieferscheinnummer, acEntire, , acSearchAll, , acCurrent - - - -End Sub - -Private Sub BAbwertenAlt_Click() - - -Dim wert1 -Dim Wert As Double -Dim aktLieferscheinnummer -Dim db1 As Database - -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim rs3 As Recordset -Dim rs4 As Recordset - -aktLieferscheinnummer = TLieferscheinnummer - -If OAbgewertet = True Then - MsgBox "Dieser Lieferschein wurde bereits abgewertet !", vbCritical - Exit Sub -End If - -If OStorniert = True Then - MsgBox "Ein stornierter Lieferschein kann nicht abgewertet werden !", vbCritical - Exit Sub -End If - -If TOechsle < CLng(GetParameter("ABWERTUNGOECHSLE")) Then - MsgBox "Die Abwertung macht keinen Sinn, da Oechsle bereits niedriger", vbCritical - Exit Sub -End If - -wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?") - -If IsNull(wert1) Or wert1 = "" Then - MsgBox "Sie haben kein gültiges Gewicht eingegeben - Abwertung abgebrochen !", vbCritical - Exit Sub -End If - -If wert1 > 0 Then - Wert = wert1 - If Wert >= TGewicht Then - MsgBox ("Gesamte Lieferung abwerten") - OAbgewertet = True - TOechsleOriginal = TOechsle - TQSNROriginal = TQSNR - 'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt - If Not IsNull(TSANR) And TSANR <> "" Then - If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then - 'Keine Oechslereduktion - Else - TOechsle = GetParameter("ABWERTUNGOECHSLE") - End If - Else - If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then - 'Keine Oechslereduktion - Else - TOechsle = GetParameter("ABWERTUNGOECHSLE") - End If - End If - - TLieferscheinnummer = TLieferscheinnummer + "A" - 'TQSNR = 1 - 'CP 20.11.2011: Änderung auf Qualitätsstufe 0 = 'Wein - TQSNR = 0 - - Else - MsgBox ("Teil der Lieferung abwerten - Neuen Lieferschein erstellen") - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("TLieferungen") - Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(TLINR)) - rs1.AddNew - - rs1!MGNR = rs2!MGNR - rs1!GNR = rs2!GNR - rs1!RNR = rs2!RNR - - rs1!ZNR = rs2!ZNR - rs1!SNR = rs2!SNR - If Not IsNull(rs2!SANR) Then - rs1!SANR = rs2!SANR - End If - rs1!Lieferscheinnummer = rs2!Lieferscheinnummer + "A" - rs1!Datum = rs2!Datum - rs1!Uhrzeit = rs2!Uhrzeit - rs1!Anmerkung = rs2!Anmerkung - rs1!Gerebelt = rs2!Gerebelt - - rs1!LINR = DMax("LINR", "TLieferungen") + 1 - rs1!OechsleOriginal = rs2!Oechsle - - 'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt - If Not IsNull(TSANR) And TSANR <> "" Then - If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then - 'Keine Oechslereduktion - rs1!Oechsle = rs2!Oechsle - Else - rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE") - End If - Else - If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then - 'Keine Oechslereduktion - rs1!Oechsle = rs2!Oechsle - Else - rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE") - End If - End If - - rs1!Abgewertet = True - rs1!Gewicht = Wert - rs1!QSNROriginal = rs2!QSNR - rs1!QSNR = 0 - 'TQSNR = 1 - 'CP 20.11.2011: Änderung auf Qualitätsstufe 0 = 'Wein - 'TQSNR = 0 - rs1!Handwiegung = False - rs1!Storniert = False - - 'Abschläge kopieren - Set rs3 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE LINR=" + Format(TLINR)) - Set rs4 = db1.OpenRecordset("TLieferungAbschlag") - While Not rs3.EOF - rs4.AddNew - rs4!LINR = rs1!LINR - rs4!ASNR = rs3!ASNR - rs4.Update - rs3.MoveNext - Wend - rs3.Close - rs4.Close - - rs1.Update - rs1.Close - rs2.Close - TGewicht = TGewicht - Wert - End If -End If - -Requery -TLieferscheinnummer.SetFocus -'DoCmd.FindRecord aktLieferscheinnummer, acEntire, , acSearchAll, , acCurrent - - - -End Sub - -Private Sub Befehl114_Click() - -Dim Wert - -Wert = InputBox("Geben Sie bitte das Gewicht an:", "Manuelle Gewichtseingabe") - -If Wert <> "" And Not IsNull(Wert) Then - -TGewicht.SetFocus -TGewicht = Wert - -OHandwiegung = 1 - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll -End If - -End Sub - - - -Private Sub Befehl170_Click() - -Dim str1 As String -Dim rnr1 As Long - -str1 = InputBox("Bitte geben Sie die Riedbezeichnung ein:") - -If str1 <> "" And Not IsNull(str1) Then - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TRiede;") - -rs1.AddNew -rnr1 = DMax("[RNR]", "TRiede") + 1 -rs1!RNR = rnr1 -rs1!GNR = Forms!FLieferungen!TGNR -rs1!Bezeichnung = str1 -rs1.Update -rs1.Close -TRNR.Requery -TRNR = rnr1 - - -End If - - -End Sub - -Private Sub Befehl183_Click() - -If Not IsNull(TMGNR) And TMGNR <> "" Then - DoCmd.OpenForm "FMitgliedInfo" -End If - -End Sub - - - - - - - -Private Sub Befehl194_Click() - -End Sub - -Private Sub BVorschau_Click() - -Dim LieferscheinName As String - -If IsNull(GetParameter("LIEFERSCHEINART")) Then - SetParameter "LIEFERSCHEINART", "2" -End If - -LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART") -DoCmd.OpenReport LieferscheinName, acViewPreview, , "[LINR]=" + Format(Forms!FLieferungen!TLINR) - -' If GetParameter("LIEFERSCHEINART") = "1" Then -' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR) -' Else -' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR) -' End If - -End Sub - -Private Sub Form_Activate() - -RefreshAll - -End Sub - - - - -Private Sub Kombinationsfeld105_Change() - -TSNR = TSorte - -End Sub - - - -Private Sub Form_Current() - -RefreshAll -TMGNR.SetFocus - -End Sub - -Private Sub Form_Load() -'TOechsle.SetFocus - -If Not IsNull(DFirst("LINR", "TLieferungen")) Then - DoCmd.GoToRecord acActiveDataObject, , acLast - RefreshAll -Else - MsgBox ("Keine Lieferungen vorhanden !") - 'Forms!FLieferungen.Close -End If -'TMGNR.SetFocus - - -End Sub - -Private Sub Kombinationsfeld125_Exit(Cancel As Integer) - -End Sub - - - -Private Sub LBishergeliefert_DblClick(Cancel As Integer) - -Dim LINR1 -If Not IsNull(LBishergeliefert) Then - 'TLieferscheinnummer.SetFocus - LINR1 = LBishergeliefert - Forms!FLieferungen.RecordSource = "SELECT TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Telefon, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.[Aktives Mitglied], TMitglieder.Eintrittsdatum, TMitglieder.Austrittsdatum, TMitglieder.Ort, TMitglieder.Straße, TLieferungen.* FROM TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR WHERE LINR=" + Format(LINR1) -End If - -End Sub - - -Private Sub OSpaetlese_Click() - -Dim Oechsle As Long -Dim QSNR As Long -Oechsle = CLng(TOechsle.Value) -QSNR = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(Oechsle) + " AND Bis>=" + Format(Oechsle)) - -If QSNR = 5 Then - If OSpaetlese.Value = True Then - TQSNR = 5 - Else - TQSNR = 3 - End If -End If - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll - - -End Sub - -Private Sub TCNR_Click() - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -If MsgBox("Soll sich die nachträgliche Chargenzuordnung auch auf die Chargenmengen auswirken?", vbYesNo) Then - ChargenLieferungenZuordnungÄndern TLINR, CNRAlt, TCNR -End If - - -End Sub - -Private Sub TCNR_GotFocus() -CNRAlt = TCNR -End Sub - -Private Sub TGewicht_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll - -End Sub - - - - -Private Sub TGNR_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll -TRNR.Requery - -End Sub - -Private Sub TMitglied_Click() - -TMGNR = TMitglied - -End Sub - -Private Sub TOechsle_Exit(Cancel As Integer) - -If IsNull(TOechsle) Or TOechsle = 0 Or TOechsle = "" Then -Else - TQSNR.Value = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(TOechsle) + " AND Bis>=" + Format(TOechsle)) -End If - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll - -End Sub - -Sub RefreshAll() - -Dim w1 - -w1 = TOechsle - -If Not IsNull(w1) And w1 <> "" Then - 'TQualitaetsstufe.Caption = DMax("Bezeichnung", "TQualitaetsstufen", "QSNR=" + Format(TQSNR)) - If Qualitätsstufe(CDbl(w1)) = "Spätlese" Then - OSpaetlese.Visible = True - Else - OSpaetlese.Visible = False - End If - TKW.Caption = "= " + Format((DMax("[KW]", "TUmrechnung", "Oechsle=" + Format(TOechsle)))) + " ° KW" -Else - 'TQualitaetsstufe.Caption = "" - TKW.Caption = "" -End If - -If Not IsNull(TGNR) Then - TGLNR = DFirst("[GLNR]", "TGemeinden", "GNR=" + Format(TGNR)) - TWBGNR = GetGebietGLNR(TSNR, TQSNR, TGLNR) - 'TWBGNR = DFirst("[WBGNR]", "TGrosslagen", "GLNR=" + Format(TGLNR)) - TRGNR = DFirst("[RGNR]", "TGebiete", "WBGNR=" + Format(TWBGNR)) -End If - - -LBishergeliefert.Requery - -End Sub - - -Private Sub Befehl133_Click() -On Error GoTo Err_Befehl133_Click - - - DoCmd.GoToRecord , , acFirst - -Exit_Befehl133_Click: - Exit Sub - -Err_Befehl133_Click: - MsgBox Err.Description - Resume Exit_Befehl133_Click - -End Sub -Private Sub Befehl134_Click() -On Error GoTo Err_Befehl134_Click - - - DoCmd.GoToRecord , , acPrevious - -Exit_Befehl134_Click: - Exit Sub - -Err_Befehl134_Click: - MsgBox Err.Description - Resume Exit_Befehl134_Click - -End Sub -Private Sub Befehl135_Click() -On Error GoTo Err_Befehl135_Click - - - DoCmd.GoToRecord , , acNext - -Exit_Befehl135_Click: - Exit Sub - -Err_Befehl135_Click: - MsgBox Err.Description - Resume Exit_Befehl135_Click - -End Sub -Private Sub Befehl136_Click() -On Error GoTo Err_Befehl136_Click - - - DoCmd.GoToRecord , , acLast - -Exit_Befehl136_Click: - Exit Sub - -Err_Befehl136_Click: - MsgBox Err.Description - Resume Exit_Befehl136_Click - -End Sub -Private Sub Befehl137_Click() - -On Error GoTo Err_Befehl137_Click - - - DoCmd.GoToRecord , , acNewRec - -Exit_Befehl137_Click: - Exit Sub - -Err_Befehl137_Click: - MsgBox Err.Description - Resume Exit_Befehl137_Click - -TMGNR.SetFocus - - -End Sub -Private Sub Befehl138_Click() - -If MsgBox("Sind Sie sicher, daß Sie diesen Datensatz löschen möchten (ev. stornieren) ?", vbYesNo) = vbYes Then - -On Error GoTo Err_Befehl138_Click - - - DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 - DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70 - -Exit_Befehl138_Click: - Exit Sub - -Err_Befehl138_Click: - MsgBox Err.Description - Resume Exit_Befehl138_Click - - -End If - -End Sub - -Private Sub Befehl141_Click() - -If MsgBox("Wollen Sie diese Lieferung wirklich stornieren ?", vbYesNo) = vbYes Then - - If Not IsNull(TCNR) And TGewicht > 0 And TOechsle > 0 Then - If MsgBox("Wollen Sie die Liefermenge bei der zugeordneten Charge ebenfalls abziehen?", vbYesNo) = vbYes Then - ChargeBefuellungRueckgaengig TCNR, TLINR - TCNR = "" - End If - End If - - TGewicht = 0 - OStorniert = 1 - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll - -End If - - -End Sub - -Private Sub TSNR_Exit(Cancel As Integer) - -Dim SNR1 As String -Dim SANR1 As String - - -If IsNull(TSNR) Then - Exit Sub -End If - -If GetSNRAndSANRFromInput(TSNR, SNR1, SANR1) Then - TSNR = SNR1 - TSANR = SANR1 -Else - TSANR = Null -End If - -If DCount("[SNR]", "TSorten", "SNR='" + TSNR + "'") = 0 Then - MsgBox "Bitte geben Sie ein gültiges Sortenkürzel ein!", vbCritical - 'TSNR = - TSNR.SetFocus - Exit Sub -End If - - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll -End Sub - - - -Private Sub Befehl175_Click() - -Dim LieferscheinName As String - -If GetParameter("LIEFERSCHEINART") = Null Then - SetParameter "LIEFERSCHEINART", 2 -End If - -LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART") -DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FLieferungen!TLINR) - -' If GetParameter("LIEFERSCHEINART") = "1" Then -' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR) -' Else -' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR) -' End If - -End Sub - - - - - -Private Sub Befehl186_Click() - -DoCmd.OpenForm "MLieferungSuchen" - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FMandant.frm b/wgmaster/vba/form/Form_FMandant.frm deleted file mode 100644 index ed4121b..0000000 --- a/wgmaster/vba/form/Form_FMandant.frm +++ /dev/null @@ -1,61 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Kombinationsfeld39_Change() - -TBlz = TBank - -End Sub - -Private Sub Form_Close() - -If Not IsNull(TName1) Then SetParameter "MANDANTENNAME1", TName1 -If Not IsNull(TName2) Then SetParameter "MANDANTENNAME2", TName2 -If Not IsNull(TStrasse) Then SetParameter "MANDANTENSTRASSE", TStrasse -If Not IsNull(TPLZ) Then SetParameter "MANDANTENPLZ", TPLZ -If Not IsNull(TOrt) Then SetParameter "MANDANTENORT", TOrt -If Not IsNull(TTelefon) Then SetParameter "MANDANTENTELEFON", TTelefon -If Not IsNull(TTelefax) Then SetParameter "MANDANTENTELEFAX", TTelefax -If Not IsNull(TDvr) Then SetParameter "MANDANTENDVR", TDvr -If Not IsNull(TBetriebsnummer) Then SetParameter "MANDANTENBETRIEBSNUMMER", TBetriebsnummer -If Not IsNull(TBlz) Then SetParameter "MANDANTENBLZ", TBlz -If Not IsNull(TKontonummer) Then SetParameter "MANDANTENKONTONUMMER", TKontonummer -If Not IsNull(TUID) Then SetParameter "MANDANTENUID", TUID -If Not IsNull(TEMail) Then SetParameter "MANDANTENEMAIL", TEMail -If Not IsNull(THomepage) Then SetParameter "MANDANTENHOMEPAGE", THomepage - -End Sub - -Private Sub Form_Open(Cancel As Integer) - - -If Not IsNull(GetParameter("MANDANTENNAME1")) Then TName1 = GetParameter("MANDANTENNAME1") -If Not IsNull(GetParameter("MANDANTENNAME2")) Then TName2 = GetParameter("MANDANTENNAME2") -If Not IsNull(GetParameter("MANDANTENSTRASSE")) Then TStrasse = GetParameter("MANDANTENSTRASSE") -If Not IsNull(GetParameter("MANDANTENPLZ")) Then TPLZ = GetParameter("MANDANTENPLZ") -If Not IsNull(GetParameter("MANDANTENORT")) Then TOrt = GetParameter("MANDANTENORT") -If Not IsNull(GetParameter("MANDANTENTELEFON")) Then TTelefon = GetParameter("MANDANTENTELEFON") -If Not IsNull(GetParameter("MANDANTENTELEFAX")) Then TTelefax = GetParameter("MANDANTENTELEFAX") -If Not IsNull(GetParameter("MANDANTENDVR")) Then TDvr = GetParameter("MANDANTENDVR") -If Not IsNull(GetParameter("MANDANTENBETRIEBSNUMMER")) Then TBetriebsnummer = GetParameter("MANDANTENBETRIEBSNUMMER") -If Not IsNull(GetParameter("MANDANTENBLZ")) Then TBlz = GetParameter("MANDANTENBLZ") -If Not IsNull(GetParameter("MANDANTENBLZ")) Then TBank = GetParameter("MANDANTENBLZ") -If Not IsNull(GetParameter("MANDANTENKONTONUMMER")) Then TKontonummer = GetParameter("MANDANTENKONTONUMMER") -If Not IsNull(GetParameter("MANDANTENUID")) Then TUID = GetParameter("MANDANTENUID") -If Not IsNull(GetParameter("MANDANTENEMAIL")) Then TEMail = GetParameter("MANDANTENEMAIL") -If Not IsNull(GetParameter("MANDANTENHOMEPAGE")) Then THomepage = GetParameter("MANDANTENHOMEPAGE") - - -End Sub - -Private Sub TBank_Change() - -TBlz = TBank - -End Sub - -Private Sub TBlz_Exit(Cancel As Integer) - -TBank = TBlz - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FMitglieder.frm b/wgmaster/vba/form/Form_FMitglieder.frm deleted file mode 100644 index 8a59fb9..0000000 --- a/wgmaster/vba/form/Form_FMitglieder.frm +++ /dev/null @@ -1,288 +0,0 @@ -Option Compare Database -Option Explicit - -Dim select1 As String -Dim where1 As String -Dim order1 As String - - - - - -Private Sub Befehl81_Click() - - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - DoCmd.OpenForm "MMitgliederliste" - -End Sub - -Private Sub Befehl86_Click() - -order1 = " ORDER BY MGNR;" -RequeryListe - -End Sub - -Private Sub Befehl87_Click() - -order1 = " ORDER BY Nachname,Vorname;" -RequeryListe - -End Sub - -Private Sub BLöschen_Click() - -If MsgBox("Wollen Sie dieses Mitglied wirklich löschen ?", vbYesNo) = vbYes Then - DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 - DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70 - LMitglieder.Requery -End If - -End Sub - -Private Sub BNeu_Click() - -Dim str1 As String -Dim mgnr1 As Long - -str1 = InputBox("Bitte geben Sie den Familiennamen des Mitglieds ein:") -If str1 <> "" Then -DoCmd.GoToRecord , , acNewRec -TNachname.SetFocus -TNachname = str1 -TMGNR.SetFocus -mgnr1 = TMGNR -TVorname.SetFocus -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -'DoCmd.GoToRecord , , acPrevious -LMitglieder.Requery -LMitglieder = mgnr1 - -End If - - -End Sub - -Private Sub BSuchen_Click() - -Dim suchstring -Dim rs1 As Recordset -Dim db1 As Database -Dim where2 As String - -suchstring = InputBox("Geben Sie bitte den Suchbegriff ein: ") - -If IsNull(suchstring) Or suchstring = "" Then - where1 = "" -Else - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT * FROM TMitglieder") - - If OAlleMitglieder = False Then - where1 = " WHERE [Aktives Mitglied]=True AND MGNR IN (-1," - Else - where1 = " WHERE MGNR IN (-1," - End If - - suchstring = UCase(suchstring) - - While Not rs1.EOF - If InStr(UCase(rs1!Nachname), suchstring) > 0 Or InStr(UCase(rs1!Vorname), suchstring) > 0 Or InStr(UCase(rs1!Ort), suchstring) > 0 Or InStr(UCase(Format(rs1!MGNR)), suchstring) > 0 Then - where1 = where1 + Format(rs1!MGNR) + "," - End If - rs1.MoveNext - Wend - rs1.Close - where1 = Left(where1, Len(where1) - 1) + ")" - -End If -'MsgBox (where1) - -RequeryListe - - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -LMitglieder = TMGNR -OAlleMitglieder = False -select1 = "SELECT TMitglieder.MGNR, [Nachname]+IIf(IsNull([Vorname]),'',' '+[Vorname]) AS Name1, MGNR FROM TMitglieder " -where1 = " WHERE [Aktives Mitglied]=true " -order1 = " ORDER BY Nachname,Vorname;" -LMitglieder.SetFocus -LMitglieder.Value = LMitglieder.ItemData(0) -TMGNR.SetFocus -DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True -'DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True - -End Sub - -Private Sub LMitglieder_Click() - -'Filter = "MGNR=Forms!FMitglieder.LMitglieder" -'FilterOn = True - -TMGNR.SetFocus -DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True -LMitglieder.SetFocus - -End Sub - - - -Private Sub OAlleMitglieder_Click() - -If OAlleMitglieder = False Then - where1 = " WHERE [Aktives Mitglied]=True " -Else - where1 = "" -End If - -RequeryListe - - -End Sub - - - - - - - -Private Sub Text70_Exit(Cancel As Integer) - -If Text70.Value <> "" Then -If MsgBox("Ist das Mitglied noch aktiv ?", vbYesNo) = vbYes Then - KAM.Value = 1 -Else - KAM.Value = 0 -End If -End If - -End Sub -Private Sub Befehl80_Click() - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - - SetParameter "STAMMBLATTTEXT", " " -DoCmd.OpenReport "BMitgliedStammblattMGNR", acViewPreview, , "TMitglieder.MGNR=" + Format(TMGNR) - -If GetParameter("LIEFERMENGENDRUCKEN") = "1" Then - - If DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(TMGNR) + " AND (Bis>=Year(Date()) OR Bis IS NULL)") > 0 Then - DoCmd.OpenReport "BLiefermenge", acViewPreview, , "TMitglieder.MGNR=" + Format(TMGNR) - End If - -End If - - -'DoCmd.OpenForm "MStammblatt" -'Forms!MStammblatt!TVon1 = TMGNR -'Forms!MStammblatt!TBis1 = TMGNR -'DoCmd.OpenReport "BMitgliedStammblatt", acViewPreview - -End Sub - -Private Sub TMGNR_DblClick(Cancel As Integer) - -Dim mgnr1 As Long - -mgnr1 = InputBox("Nach welcher Mitgliedsnummer soll gesucht werden ?", "Mitgliedssuche nach MGNR") - -LMitglieder = mgnr1 - -TMGNR.SetFocus -DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True -LMitglieder.SetFocus - - - -End Sub - -Private Sub TMGNR_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -End Sub - -Private Sub TMGNRV_Exit(Cancel As Integer) - -Dim Jahr1 As Long -Dim mgnr1 As Long - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -If Not IsNull(TMGNRV) And TMGNRV <> 0 Then - If DCount("FBNR", "TFlaechenbindungen", "MGNR=" + Format(TMGNRV)) > 0 Then - If MsgBox("Wollen Sie bestehende Flächenbindungen des Vorgängers übernehmen ?", vbYesNo) = vbYes Then - Jahr1 = 0 - While Jahr1 < 1900 Or Jahr1 > 2500 - Jahr1 = InputBox("Übergabejahr:") - Wend - Dim db1 As Database - Dim rs1 As Recordset 'old member - Dim rs2 As Recordset 'new member - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen WHERE MGNR=" + Format(TMGNRV)) - Set rs2 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen WHERE MGNR=" + Format(TMGNR)) - While Not rs1.EOF - ' new record - rs2.AddNew - rs2!MGNR = TMGNR - rs2!GNR = rs1!GNR - rs2!RNR = rs1!RNR - rs2!SNR = rs1!SNR - rs2!SANR = rs1!SANR - rs2!Parzellennummer = rs1!Parzellennummer - rs2!Flaeche = rs1!Flaeche - rs2!BANR = rs1!BANR - rs2!Von = Jahr1 - rs2!Bis = rs1!Bis - rs2!FBNR = DMax("[FBNR]", "TFlaechenbindungen") + 1 - rs2.Update - ' change old record: Bis - rs1.Edit - rs1!Bis = Jahr1 - 1 - rs1.Update - rs1.MoveNext - Wend - rs1.Close - rs2.Close - mgnr1 = TMGNR - FUnter.Requery - End If - End If -End If - -End Sub - -Private Sub TNachname_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -LMitglieder.Requery -LMitglieder = TMGNR - -End Sub - - -Sub RequeryListe() - -Dim mgnr1 As Long - -mgnr1 = TMGNR -LMitglieder.RowSource = select1 + where1 + order1 -LMitglieder.Requery -LMitglieder = mgnr1 -LMitglieder.SetFocus - -End Sub - -Private Sub TVorname_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -LMitglieder.Requery -LMitglieder = TMGNR - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FQualitaetsstufen.frm b/wgmaster/vba/form/Form_FQualitaetsstufen.frm deleted file mode 100644 index 2707524..0000000 --- a/wgmaster/vba/form/Form_FQualitaetsstufen.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl48_Click() -On Error GoTo Err_Befehl48_Click - - Dim stDocName As String - - stDocName = "BQualitätsstufen" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl48_Click: - Exit Sub - -Err_Befehl48_Click: - MsgBox Err.Description - Resume Exit_Befehl48_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FRegionen.frm b/wgmaster/vba/form/Form_FRegionen.frm deleted file mode 100644 index 959a69a..0000000 --- a/wgmaster/vba/form/Form_FRegionen.frm +++ /dev/null @@ -1,27 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Form_Close() - -RefreshMain - -End Sub - -Private Sub TBezeichnung_Exit(Cancel As Integer) - -RefreshMain - -End Sub - -Sub RefreshMain() - -Dim Regionsnr As Long - -Regionsnr = CLng(Forms!FRegionen!TRGNR) - -Forms!FGebietshierarchie.InitRegionen -Forms!FGebietshierarchie!LRegionen = Regionsnr -Forms!FGebietshierarchie.InitGebiete - -End Sub - diff --git a/wgmaster/vba/form/Form_FRiede.frm b/wgmaster/vba/form/Form_FRiede.frm deleted file mode 100644 index 2955164..0000000 --- a/wgmaster/vba/form/Form_FRiede.frm +++ /dev/null @@ -1,26 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Form_Close() - -RefreshMain - -End Sub - -Private Sub TBezeichnung_Exit(Cancel As Integer) - -RefreshMain - -End Sub - -Sub RefreshMain() - -Dim RNR As Long - -RNR = CLng(Forms!FRiede!TRNR) - -Forms!FGebietshierarchie.InitRiede -Forms!FGebietshierarchie!LRiede = RNR - -End Sub - diff --git a/wgmaster/vba/form/Form_FRiedeMitglied.frm b/wgmaster/vba/form/Form_FRiedeMitglied.frm deleted file mode 100644 index bf1d5c8..0000000 --- a/wgmaster/vba/form/Form_FRiedeMitglied.frm +++ /dev/null @@ -1,42 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Form_Close() - -AddNewRied - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -LGNR = Forms!FMitglieder!FUnter.Form![LGNR] -If DCount("RNR", "TRiede", "") = 0 Then - TRNR = 1 -Else - TRNR = DMax("RNR", "TRiede", "") + 1 -End If -TWGBZS = 0 - -End Sub - - -Sub AddNewRied() - -Dim db1 As Database -Dim rs1 As Recordset - -If Not IsNull(TBezeichnung) Then - - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("TRiede") - rs1.AddNew - rs1!RNR = TRNR - rs1!GNR = LGNR - rs1!Bezeichnung = TBezeichnung - rs1!RZS = TWGBZS - rs1.Update - [Forms]![FMitglieder]![FUnter].[Form]![LRiede] = TRNR -End If - - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FSorten.frm b/wgmaster/vba/form/Form_FSorten.frm deleted file mode 100644 index 6b01266..0000000 --- a/wgmaster/vba/form/Form_FSorten.frm +++ /dev/null @@ -1,25 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BSorten" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub - -Private Sub BSortenKuerzelUmbenennen_Click() - -DoCmd.OpenForm "FSortenkuerzelUmbenennen" - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FSortenkuerzelUmbenennen.frm b/wgmaster/vba/form/Form_FSortenkuerzelUmbenennen.frm deleted file mode 100644 index c261f0e..0000000 --- a/wgmaster/vba/form/Form_FSortenkuerzelUmbenennen.frm +++ /dev/null @@ -1,129 +0,0 @@ -Private Sub BUmbenennen_Click() - -DoCmd.Hourglass True -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -SortenKuerzelUmbenennen -DoCmd.Hourglass False -DoCmd.Close -Forms!FSorten.Requery - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -TempTabelleAnlegen - -Forms!FSortenkuerzelUmbenennen.RecordSource = "xTempSortenkuerzelumbenennen" -Requery - -End Sub - -Sub TempTabelleAnlegen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset - -Set db1 = CurrentDb - -If TableExists("xTempSortenkuerzelUmbenennen") Then -db1.Execute ("drop table xTempSortenkuerzelUmbenennen") -End If -db1.Execute ("Create table xTempSortenkuerzelUmbenennen (SNRAlt TEXT, BezeichnungAlt TEXT, kgprohaalt DOUBLE,typalt TEXT, SNRNeu TEXT, BezeichnungNeu TEXT, kgprohaneu DOUBLE, typneu TEXT)") -db1.Execute ("delete * from xTempSortenkuerzelumbenennen") -Set rs1 = db1.OpenRecordset("SELECT * FROM TSorten") -Set rs2 = db1.OpenRecordset("xTempSortenkuerzelumbenennen") -While Not rs1.EOF - rs2.AddNew - rs2!SNRAlt = rs1!SNR - rs2!SNRNeu = rs1!SNR - rs2!BezeichnungAlt = rs1!Bezeichnung - rs2!Bezeichnungneu = rs1!Bezeichnung - rs2!kgprohaneu = rs1!KgProHa - rs2!kgprohaalt = rs1!KgProHa - rs2!Typalt = rs1!Typ - rs2!Typneu = rs1!Typ - - rs2.Update - rs1.MoveNext -Wend -rs1.Close -rs2.Close - - -End Sub - - -Sub SortenKuerzelUmbenennen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset - -Set db1 = CurrentDb - -Set rs1 = db1.OpenRecordset("SELECT * from xTempSortenkuerzelUmbenennen ORDER BY SNRAlt") - -'1. Alle Sorten von alt auf neu mit n als Präfix -While Not rs1.EOF - - 'TAuszahlungSorten - db1.Execute ("UPDATE TAuszahlungSorten SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'") - 'TFlaechenbindungen - db1.Execute ("UPDATE TFlaechenbindungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'") - 'TLieferungen - db1.Execute ("UPDATE TLieferungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'") - 'TSorten - db1.Execute ("UPDATE TSorten SET SNR='n" + rs1!SNRNeu + "',kgproha=" + Format(rs1!kgprohaneu) + " WHERE SNR='" + Format(rs1!SNRAlt) + "'") - - rs1.MoveNext -Wend -rs1.Close - -'2. Bei allen Sorten den Präfix n entfernen - -Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNRNeu from xTempSortenkuerzelUmbenennen ORDER BY SNRNeu") -db1.Execute ("DELETE * FROM TSorten") -Set rs2 = db1.OpenRecordset("TSorten") - -While Not rs1.EOF - - 'TAuszahlungSorten - db1.Execute ("UPDATE TAuszahlungSorten SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'") - 'TFlaechenbindungen - db1.Execute ("UPDATE TFlaechenbindungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'") - 'TLieferungen - db1.Execute ("UPDATE TLieferungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'") - 'TSorten - ' db1.Execute ("UPDATE TSorten SET SNR='" + rs1!SNRneu + "' WHERE SNR='n" + rs1!SNRneu + "'") - rs2.AddNew - rs2!SNR = rs1!SNRNeu - rs2!KgProHa = DFirst("kgprohaneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'") - rs2!Bezeichnung = DFirst("Bezeichnungneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'") - rs2!Typ = DFirst("typneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'") - rs2.Update - - rs1.MoveNext -Wend -rs1.Close - - - -End Sub - -Function TableExists(table1) As Boolean - -Dim db1 As Database -Set db1 = CurrentDb -Dim x As TableDef - -For Each x In db1.TableDefs - If x.Name = table1 Then - TableExists = True - Exit Function - End If -Next x - - TableExists = False - -End Function diff --git a/wgmaster/vba/form/Form_FTextelemente.frm b/wgmaster/vba/form/Form_FTextelemente.frm deleted file mode 100644 index 13c2737..0000000 --- a/wgmaster/vba/form/Form_FTextelemente.frm +++ /dev/null @@ -1,36 +0,0 @@ -Option Compare Database -Option Explicit - - - -Private Sub Form_Close() - -If Not IsNull(TAuszahlungtext) Then SetParameter "AUSZAHLUNGTEXT", TAuszahlungtext -If Not IsNull(TLieferscheintext) Then SetParameter "LIEFERSCHEINTEXT", TLieferscheintext -If Not IsNull(TAnlieferungsbestätigung) Then SetParameter "ANLIEFTEXT", TAnlieferungsbestätigung -If Not IsNull(TAuszahlungzusatz_PA) Then SetParameter "AUSZAHLUNGZUSATZTEXT_PA", TAuszahlungzusatz_PA -If Not IsNull(TAuszahlungzusatz_BF) Then SetParameter "AUSZAHLUNGZUSATZTEXT_BF", TAuszahlungzusatz_BF -If Not IsNull(TAbsendertext1) Then SetParameter "ABSENDERTEXT1", TAbsendertext1 -If Not IsNull(TAbsendertext2) Then SetParameter "ABSENDERTEXT2", TAbsendertext2 - - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -If Not IsNull(GetParameter("AUSZAHLUNGTEXT")) Then TAuszahlungtext = GetParameter("AUSZAHLUNGTEXT") -If Not IsNull(GetParameter("LIEFERSCHEINTEXT")) Then TLieferscheintext = GetParameter("LIEFERSCHEINTEXT") -If Not IsNull(GetParameter("ANLIEFTEXT")) Then TAnlieferungsbestätigung = GetParameter("ANLIEFTEXT") -If Not IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_BF")) Then TAuszahlungzusatz_BF = GetParameter("AUSZAHLUNGZUSATZTEXT_BF") -If Not IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_PA")) Then TAuszahlungzusatz_PA = GetParameter("AUSZAHLUNGZUSATZTEXT_PA") -If Not IsNull(GetParameter("ABSENDERTEXT1")) Then TAbsendertext1 = GetParameter("ABSENDERTEXT1") -If Not IsNull(GetParameter("ABSENDERTEXT2")) Then TAbsendertext2 = GetParameter("ABSENDERTEXT2") - - -End Sub - - - - - - diff --git a/wgmaster/vba/form/Form_FUebernahmeChargenauswahl.frm b/wgmaster/vba/form/Form_FUebernahmeChargenauswahl.frm deleted file mode 100644 index 60b9e62..0000000 --- a/wgmaster/vba/form/Form_FUebernahmeChargenauswahl.frm +++ /dev/null @@ -1,18 +0,0 @@ - - -Private Sub BAuswaehlen_Click() - -If LChargen > 0 Then - Forms("FÜbernahme")!TCNR = LChargen -End If - -DoCmd.Close - -End Sub - -Private Sub LChargen_DblClick(Cancel As Integer) - -Forms("FÜbernahme")!TCNR = LChargen -DoCmd.Close - -End Sub diff --git a/wgmaster/vba/form/Form_FUmrechnung.frm b/wgmaster/vba/form/Form_FUmrechnung.frm deleted file mode 100644 index 3c87686..0000000 --- a/wgmaster/vba/form/Form_FUmrechnung.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl48_Click() -On Error GoTo Err_Befehl48_Click - - Dim stDocName As String - - stDocName = "BUmrechnung" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl48_Click: - Exit Sub - -Err_Befehl48_Click: - MsgBox Err.Description - Resume Exit_Befehl48_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_FÜbernahme.frm b/wgmaster/vba/form/Form_FÜbernahme.frm deleted file mode 100644 index 6fd20c4..0000000 --- a/wgmaster/vba/form/Form_FÜbernahme.frm +++ /dev/null @@ -1,1485 +0,0 @@ -Public TheEvent As Integer -Public TimerAus As Boolean - -Public SerialInterface As Boolean -Public FreigabeErteilt As Boolean - - -Private Sub BAbwertenAlt_Click() - - -Dim wert1 As Variant -Dim Wert As Double -Dim aktLieferscheinnummer -Dim db1 As Database - -Dim rs1 As Recordset -Dim rs2 As Recordset - -aktLieferscheinnummer = TLieferscheinnummer - -wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?") - -If Not IsNull(wert1) And wert1 > 0 Then - - Wert = wert1 - If Wert >= TGewicht Then - MsgBox ("Gesamte Lieferung abwerten") - OAbgewertet = True - TOechsleOriginal = TOechsle - TQSNROriginal = TQSNR - - 'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt - 'If Not IsNull(TSANR) And TSANR <> "" Then - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then - ' 'Keine Oechslereduktion - ' Else - ' TOechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'Else - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then - ' 'Keine Oechslereduktion - ' Else - ' TOechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'End If - - TLieferscheinnummer = TLieferscheinnummer + "A" - TQSNR = 0 - - Else - MsgBox ("Teil der Lieferung abwerten - Neuen Lieferschein erstellen") - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("TLieferungen") - Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(TLINR)) - rs1.AddNew - - rs1!MGNR = rs2!MGNR - rs1!GNR = rs2!GNR - rs1!RNR = rs2!RNR - - rs1!ZNR = rs2!ZNR - rs1!SNR = rs2!SNR - If Not IsNull(rs2!SANR) Then - rs1!SANR = rs2!SANR - End If - rs1!Lieferscheinnummer = rs2!Lieferscheinnummer + "A" - rs1!Datum = rs2!Datum - rs1!Uhrzeit = rs2!Uhrzeit - rs1!Anmerkung = rs2!Anmerkung - rs1!Gerebelt = rs2!Gerebelt - - rs1!LINR = DMax("LINR", "TLieferungen") + 1 - rs1!OechsleOriginal = rs2!Oechsle - - 'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt - 'If Not IsNull(TSANR) And TSANR <> "" Then - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then - ' 'Keine Oechslereduktion - ' rs1!Oechsle = rs2!Oechsle - ' Else - ' rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'Else - ' If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then - ' 'Keine Oechslereduktion - ' rs1!Oechsle = rs2!Oechsle - ' Else - ' rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE") - ' End If - 'End If - - rs1!Abgewertet = True - rs1!Gewicht = Wert - rs1!QSNROriginal = rs2!QSNR - rs1!QSNR = 0 - rs1!Handwiegung = False - rs1!Storniert = False - - rs1.Update - rs1.Close - rs2.Close - TGewicht = TGewicht - Wert - End If -End If - -Requery -TLieferscheinnummer.SetFocus -DoCmd.FindRecord aktLieferscheinnummer, acEntire, , acSearchAll, , acCurrent - - -End Sub - -Private Sub BChargen_Click() - -DoCmd.OpenForm "MChargenAuswahl" - -End Sub - -Private Sub BDrucken_Click() - -Dim LieferscheinName As String -Dim abschlaege1 As Integer - -abschlaege1 = GetAbschlaege - - -If GetParameter("LIEFERSCHEINART") = Null Then - SetParameter "LIEFERSCHEINART", "2" -End If - -LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART") - -If IsNull(DMax("MGNR", "TMitglieder", "[Aktives Mitglied]=True AND MGNR=Forms!FÜbernahme!TMGNR")) Then - MsgBox "Bitte zuerst gültiges Mitglied eingeben !", vbCritical - TMGNR.SetFocus - Exit Sub -End If - -If IsNull(DMax("ZNR", "TZweigstellen", "ZNR=Forms!FÜbernahme!TZweigstelle")) Then - MsgBox "Bitte zuerst gültige Zweigstelle eingeben !", vbCritical - TZweigstelle.SetFocus - Exit Sub -End If - - -If IsNull(DMax("SNR", "TSorten", "SNR=Forms!FÜbernahme!TSNR")) Then - MsgBox "Bitte zuerst gültige Sorte eingeben !", vbCritical - TSNR.SetFocus - Exit Sub -End If - -If IsNull(TGewicht) Or TGewicht = "" Then - MsgBox "Bitte zuerst wiegen !", vbCritical - If BWiegen.Enabled Then - BWiegen.SetFocus - End If - Exit Sub -End If - -If IsNull(TOechsle) Or TOechsle = "" Then - MsgBox "Bitte zuerst Oechsle eingeben !", vbCritical - TOechsle.SetFocus - Exit Sub -End If - -If IsNull(GetParameter("ABSCHLAG_ERFORDERLICH")) Then - SetParameter "ABSCHLAG_ERFORDERLICH", "0" -End If - -If GetParameter("ABSCHLAG_ERFORDERLICH") = "1" And abschlaege1 = 0 Then - MsgBox "Es muss mindestens ein Abschlag vergeben werden!", vbCritical - Exit Sub -End If - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -If Not IsNull(TCNR) Then - If ChargeStandNachFuellung(LINR) > 0 And GetParameter("CHARGENWARNUNG_BEHAELTERVOLL") = "Ja" Then - If MsgBox("Diese Lieferung würde den Behälter um " + Format(ChargeStandNachFuellung(LINR)) + " überfüllen. Wollen Sie trotzdem diese Lieferung dieser Charge zuordnen und fortsetzen?", vbYesNo) = vbNo Then - TCNR = Null - Exit Sub - - End If - Else - If ChargeStandNachFuellung(LINR) > -GetParameter("CHARGENWARNUNG_BEHAELTERFASTVOLL") Then - MsgBox ("Warnung! Im Behälter der gewählten Charge sind nach dieser Befüllung nur noch " + Format(-ChargeStandNachFuellung(LINR)) + " frei") - End If - End If -End If - - -TMGNR.SetFocus -BDrucken.Enabled = False - - -If Not IsNull(TCNR) Then - OAufChargeverbucht = ChargeBefuellen(TCNR, TLINR) -End If - -If IsNull(TLieferscheinnummer) Or TLieferscheinnummer = "" Then - 'Noch keine Lieferscheinnummer - - ' Switch RTS for 3 seconds -> Waage Freigabe - - TheEvent = 0 - If GetParameter("STEUERUNGTYP") = "SERIELL" Then - If XCommSteuerung.PortOpen = 0 Then - On Error GoTo WeiterNachKippen - XCommSteuerung.PortOpen = 1 - End If - End If - - TimerAus = True - Kippen (True) - While TheEvent < 3 - DoEvents - Wend - Kippen (False) - TimerAus = False - - If GetParameter("STEUERUNGTYP") = "SERIELL" Then - If XCommSteuerung.PortOpen = 1 Then - On Error GoTo WeiterNachKippen - XCommSteuerung.PortOpen = 0 - End If - End If - -WeiterNachKippen: - - On Error Resume Next - ' Lieferscheinnummer setzen - - SetLieferscheinnummer - - 'Ausdrucken - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - - - DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - If GetParameter("LIEFERSCHEINART") <> "1" Then - '2x drucken - DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - End If - - - - 'If GetParameter("LIEFERSCHEINART") = "1" Then - ' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - 'Else - ' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - ' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - 'End If - - ' new record - - NewLieferschein - - -Else - ' Lieferschein bereits 1x gedruckt (kein Kippen, kein neuer Datensatz, keine Lieferscheinnummer - ' nur ausdrucken - DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - - 'If GetParameter("LIEFERSCHEINART") = "1" Then - ' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - 'Else - ' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR) - 'End If - -End If - - -BDrucken.Enabled = True - - -End Sub - -Private Sub Befehl114_Click() - -Dim Wert - -Wert = InputBox("Geben Sie bitte das Gewicht an:", "Manuelle Gewichtseingabe") - -If Wert <> "" And Not IsNull(Wert) Then - -TGewicht.SetFocus -TGewicht = Wert - -OHandwiegung = 1 - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll -End If - -End Sub - - - -Private Sub Befehl170_Click() - -Dim str1 As String -Dim rnr1 As Long - -str1 = InputBox("Bitte geben Sie die Riedbezeichnung ein:") - -If str1 <> "" And Not IsNull(str1) Then - -Dim db1 As Database -Dim rs1 As Recordset - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TRiede;") - -rs1.AddNew -rnr1 = DMax("[RNR]", "TRiede") + 1 -rs1!RNR = rnr1 -rs1!GNR = Forms!FÜbernahme!TGNR -rs1!Bezeichnung = str1 -rs1.Update -rs1.Close -TRNR.Requery -TRNR = rnr1 - - -End If - - -End Sub - -Private Sub Befehl183_Click() - -If Not IsNull(TMGNR) And TMGNR <> "" Then - DoCmd.OpenForm "FMitgliedInfo" -End If - -End Sub - -Private Sub Befehl184_Click() - - -SetLieferscheinnummer - -End Sub - -Private Sub Befehl189_Click() - -If LBishergeliefert.Visible = True Then - LBishergeliefert.Visible = False - TLiefersumme.Visible = False - XSumme1.Visible = False - XFeld1.Visible = False - XFeld2.Visible = False - XFeld3.Visible = False - XFeld4.Visible = False - XFeld5.Visible = False - -Else - LBishergeliefert.Visible = True - TLiefersumme.Visible = True - XSumme1.Visible = True - XFeld1.Visible = True - XFeld2.Visible = True - XFeld3.Visible = True - XFeld4.Visible = True - XFeld5.Visible = True -End If - - -End Sub - - -Private Sub BKippen_Click() - -' Switch RTS for 3 seconds - -TheEvent = 0 -'MsgBox ("Kippen auslösen") -Kippen (True) -While TheEvent < 3 - DoEvents -Wend -'MsgBox ("Kippen zurück") -Kippen (False) - -End Sub - -Private Sub BS1_Click() - -Dim ASNR1 As Long -Dim db1 As Database -Dim rs1 As Recordset - -ASNR1 = BS1.Tag - -'Check if this ASNR is already assigned -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR)) -If rs1.recordcount > 0 Then - Exit Sub - rs1.Close -End If - -'Add to Table TLieferungenAbschlaege -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag") -rs1.AddNew -rs1!LINR = TLINR -rs1!ASNR = ASNR1 -rs1.Update -FAbschlaege.Requery -rs1.Close - - - -End Sub - -Private Sub BS2_Click() - -Dim ASNR1 As Long -Dim db1 As Database -Dim rs1 As Recordset - -ASNR1 = BS2.Tag - -'Check if this ASNR is already assigned -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR)) -If rs1.recordcount > 0 Then - Exit Sub - rs1.Close -End If - -'Add to Table TLieferungenAbschlaege -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag") -rs1.AddNew -rs1!LINR = TLINR -rs1!ASNR = ASNR1 -rs1.Update -FAbschlaege.Requery -rs1.Close - -End Sub - -Private Sub BS3_Click() - -Dim ASNR1 As Long -Dim db1 As Database -Dim rs1 As Recordset - -ASNR1 = BS3.Tag - -'Check if this ASNR is already assigned -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR)) -If rs1.recordcount > 0 Then - Exit Sub - rs1.Close -End If - -'Add to Table TLieferungenAbschlaege -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag") -rs1.AddNew -rs1!LINR = TLINR -rs1!ASNR = ASNR1 -rs1.Update -FAbschlaege.Requery -rs1.Close - -End Sub - -Private Sub BS4_Click() - -Dim ASNR1 As Long -Dim db1 As Database -Dim rs1 As Recordset - -ASNR1 = BS4.Tag - -'Check if this ASNR is already assigned -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR)) -If rs1.recordcount > 0 Then - Exit Sub - rs1.Close -End If - -'Add to Table TLieferungenAbschlaege -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag") -rs1.AddNew -rs1!LINR = TLINR -rs1!ASNR = ASNR1 -rs1.Update -FAbschlaege.Requery -rs1.Close - -End Sub - -Private Sub BWiegen_Click() - -' Wiegung durchführen -Dim i As Integer -Dim countit -Dim retryvalue - -Dim Datum As Date -Dim zeit As Date -Dim Gewicht As Long -Dim Waagentext As String - -TimerAus = True - -If IsNull(DMax("MGNR", "TMitglieder", "[Aktives Mitglied]=True AND MGNR=Forms!FÜbernahme!TMGNR")) Then - MsgBox "Bitte zuerst gültiges Mitglied eingeben !", vbCritical - TMGNR.SetFocus - Exit Sub -End If - -If IsNull(DMax("SNR", "TSorten", "SNR=Forms!FÜbernahme!TSNR")) Then - MsgBox "Bitte zuerst gültige Sorte eingeben !", vbCritical - TSNR.SetFocus - Exit Sub -End If - -If GetParameter("UEBERNAME_WIEGENVOROECHSLE") = "0" Then - If IsNull(TOechsle) Or TOechsle = "" Then - MsgBox "Bitte zuerst Oechsle eingeben !", vbCritical - TOechsle.SetFocus - Exit Sub - End If -End If - - -DoCmd.Hourglass True -TGewicht.SetFocus -BWiegen.Enabled = False - -retryvalue = GetParameter("RETRY") -If IsNull(retryvalue) Or retryvalue = "" Then - retryvalue = 10 - SetParameter "RETRY", CLng(retryvalue) -Else - retryvalue = CLng(retryvalue) -End If - -If SerialInterface Then - If XComm.PortOpen = 0 Then - On Error GoTo PortOpenError1 - XComm.PortOpen = 1 - End If -End If - -countit = 0 -i = -1 -While i < 0 And countit < retryvalue - If SerialInterface Then - XComm.InBufferCount = 0 - End If - i = Wiegen(Datum, zeit, Gewicht, Waagentext) - countit = countit + 1 -Wend - -If SerialInterface Then - XComm.PortOpen = 0 -End If - -DoCmd.Hourglass False - -BWiegen.Enabled = True -If i >= 0 Then - - If Not IsNull(Datum) And Datum > DateValue("1.1.2000") Then - TDatum = Datum - End If - If Not IsNull(Uhrzeit) And Uhrzeit > TimeValue("3:00") Then - TUhrzeit = zeit - End If - If Not IsNull(Gewicht) Then - TGewicht.SetFocus - TGewicht = Gewicht - Else - TGewicht = i - End If - If Not IsNull(Waagentext) Then - TWaagentext = Waagentext - End If - - OHandwiegung = 0 - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll -Else - MsgBox "Fehler Nr. " + Format(i) + ": Waage nicht bereit !", vbCritical - BWiegen.SetFocus -End If - -TimerAus = False - -Exit Sub - -PortOpenError1: - MsgBox ("COM Port für Waage nicht verfügbar") - 'BWiegen.Enabled = False - Exit Sub - -End Sub - - - -Private Sub FAbschlaege_Exit(Cancel As Integer) - - GetAbschlaege - -End Sub - -Private Sub Form_Activate() - -'RefreshAll -TCNR.Requery - -End Sub - - - - -Private Sub Kombinationsfeld105_Change() - -TSNR = TSorte - -End Sub - - -Private Sub Form_BeforeUpdate(Cancel As Integer) - -If TLINR <> DMax("LINR", "TLieferungen") And Not IsNull(TLieferscheinnummer) And TLieferscheinnummer <> "" Then - If MsgBox("Diese Lieferung wurde bereits ausgedruckt ! Sind Sie sicher, dass Sie die Daten ändern möchten ?", vbYesNo) = vbNo Then - DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70 - End If -End If - - -End Sub - -Private Sub Form_Close() - -TimerAus = True - - LetztenLieferscheinLöschen - - TheEvent = 10 - - - WiegenBeenden - - If SerialInterface Then - If XComm.PortOpen = 1 Then - XComm.PortOpen = 0 - End If - If XCommSteuerung.PortOpen = 1 Then - XCommSteuerung.PortOpen = 0 - End If - End If - - -End Sub - -Private Sub Form_Current() - -'MsgBox ("BeimAnzeigen") -RefreshAll -TMGNR.SetFocus - - -End Sub - - - -Private Sub Form_Open(Cancel As Integer) - -TimerAus = False -Freigabe (True) -FreigabeErteilt = True - -SchnellauswahlAnlegen -NewLieferschein -RefreshAll - -'Reihenfolge TOechsle-BWiegen -If IsNull(GetParameter("UEBERNAME_WIEGENVOROECHSLE")) Then - SetParameter "UEBERNAME_WIEGENVOROECHSLE", "0" -End If -If GetParameter("UEBERNAME_WIEGENVOROECHSLE") = "1" Then - BWiegen.TabIndex = 8 - TGewicht.TabIndex = 9 - TOechsle.TabIndex = 10 - BDrucken.TabIndex = 11 -End If - - -WiegenInitialisieren - -'Serial interface needed? -If GetParameter("WAAGENTYP") = "L246" Then - SerialInterface = False -Else - SerialInterface = True -End If - -'COM Port Waage öffnen -If SerialInterface Then - XComm.Settings = GetParameter("WAAGEPORTSETTINGS") - XComm.CommPort = GetParameter("WAAGEPORT") - XCommSteuerung.CommPort = GetParameter("STEUERUNGPORT") -End If - -'DoCmd.Save acForm, "FÜbernahme" -'DoCmd.Close acForm, "FÜbernahme", acSaveYes - - - -If IsNull(GetParameter("UEBERNAHME_WAAGESENDETZUERST")) Then - SetParameter "UEBERNAHME_WAAGESENDETZUERST", "0" -End If -If GetParameter("UEBERNAHME_WAAGESENDETZUERST") = "1" Then - 'port öffnen - If SerialInterface Then - If XComm.PortOpen = 0 Then - On Error GoTo PortOpenError1 - XComm.PortOpen = 1 - End If - End If - BWiegen.Enabled = False -End If - -If GetParameter("WAAGENMONITOR") = "1" Then - 'port öffnen - If SerialInterface Then - If XComm.PortOpen = 0 Then - On Error GoTo PortOpenError1 - XComm.PortOpen = 1 - End If - End If -End If - -Exit Sub - -PortOpenError1: - MsgBox ("COM Port für Waage nicht verfügbar") - 'BWiegen.Enabled = False - Exit Sub - -End Sub - -Private Sub Form_Timer() - -Dim Datum As Date -Dim zeit As Date -Dim Gewicht As Long -Dim Waagentext As String -Dim gewichtslimit As String -Dim result As Integer - - - TheEvent = TheEvent + 1 - - If GetParameter("UEBERNAHME_WAAGESENDETZUERST") = "1" And TimerAus = False Then - If Forms!FÜbernahme!XComm.InBufferCount > 0 Then - result = Wiegen(Datum, zeit, Gewicht, Waagentext) - If result >= 0 Then - If Not IsNull(Datum) Then - TDatum = Datum - End If - If Not IsNull(Uhrzeit) Then - TUhrzeit = zeit - End If - If Not IsNull(Gewicht) Then - TGewicht.SetFocus - TGewicht = Gewicht - Else - TGewicht = i - End If - If Not IsNull(Waagentext) Then - TWaagentext = Waagentext - End If - OHandwiegung = 0 - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll - Else - If result <> -9 Then - MsgBox "Fehler bei Kommunikation mit Waage!", vbCritical - End If - End If - End If - End If - - gewichtslimit = GetParameter("WAAGENMONITORLIMIT") - - If GetParameter("WAAGENMONITOR") = "1" And TimerAus = False Then - result = Wiegen(Datum, zeit, Gewicht, Waagentext, True) - If result >= 0 Then - 'TTest = Format(result) + ": " + Format(Datum, "dd.mm.yyyy") + " " + Format(zeit, "hh:MM:ss") + " " + Format(Gewicht, "0") + "kg " + waagentext - TGewichtMonitor = Gewicht - Else - 'TTest = Format(result) - End If - If result >= 0 Then - If Not IsNull(Gewicht) Then - If Gewicht >= gewichtslimit Then - DoCmd.Beep - - If FreigabeErteilt = True Then - Freigabe (False) - FreigabeErteilt = False - End If - - - - 'If TheEvent Mod 2 = 0 Then - ' Forms!FÜbernahme.Section(0).BackColor = 10874304 - 'Else - Forms!FÜbernahme.Section(0).BackColor = &HFF - 'End If - Else - Forms!FÜbernahme.Section(0).BackColor = 10874304 - If FreigabeErteilt = False Then - Freigabe (True) - FreigabeErteilt = True - End If - - End If - End If - Else - 'MsgBox "Fehler bei Kommunikation mit Waage!", vbCritical - End If - End If - -End Sub - -Private Sub LBishergeliefert_DblClick(Cancel As Integer) - -If Not IsNull(LBishergeliefert) Then - TLieferscheinnummer.SetFocus - DoCmd.FindRecord LBishergeliefert, acEntire, , acSearchAll, , acCurrent -End If - -End Sub - -Private Sub OAbgewertet_Click() - -If OAbgewertet = True Then - If Right(TLieferscheinnummer, 1) <> "A" Then - TLieferscheinnummer = TLieferscheinnummer + "A" - End If -Else - If Right(TLieferscheinnummer, 1) = "A" Then - TLieferscheinnummer = Left(TLieferscheinnummer, Len(TLieferscheinnummer) - 1) - End If -End If - -End Sub - -Private Sub OGerebelt_Alt_Click() - - - 'If MsgBox("Soll der entsprechende Gewichtsanteil abgezogen werden ?", vbYesNo) = vbYes Then - - Dim ra As Double - Dim gw As Double - - ra = CDbl(GetParameter("REBELABZUG")) - - gw = TGewicht - - - If OGerebelt.Value = False Then - - gw = gw * (100 - ra) / 100 - - Else - - gw = gw / (100 - ra) * 100 - - End If - - - TGewicht = gw - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll - - 'End If - - -End Sub - -Private Sub OSpaetlese_Click() - -Dim Oechsle As Long -Dim QSNR As Long -Oechsle = CLng(TOechsle.Value) -QSNR = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(Oechsle) + " AND Bis>=" + Format(Oechsle)) - -If QSNR = 5 Then - If OSpaetlese.Value = True Then - TQSNR = 5 - Else - TQSNR = 3 - End If -End If - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll - - -End Sub - -Private Sub TGewicht_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll - -End Sub - - - - -Private Sub TGNR_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 -RefreshAll -TRNR.Requery - -End Sub - -Private Sub TMGNR_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -End Sub - -Private Sub TMitglied_Click() - -TMGNR = TMitglied - -End Sub - -Private Sub TMitglied_Exit(Cancel As Integer) - -DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - -Dim ort1 -Dim GNR1 - -If Not IsNull(TMGNR) And Not IsNull(TOrt) Then - - ort1 = TOrt - If InStr(ort1, " ") > 0 Then - ort1 = Left(ort1, InStr(ort1, " ") - 1) - End If - - GNR1 = DFirst("GNR", "TGemeinden", "Bezeichnung='" + ort1 + "'") - If Not IsNull(GNR1) Then - TGNR = GNR1 - Else - 'Voller Ortsname ohne Leerzeichen - GNR1 = DFirst("GNR", "TGemeinden", "Bezeichnung='" + TOrt + "'") - If Not IsNull(GNR1) Then - TGNR = GNR1 - End If - End If - - -End If - -VollieferantenZuschlagEintragen - -End Sub - - - -Private Sub TOechsle_Exit(Cancel As Integer) - -Dim CNR1 As Integer - -If IsNull(TOechsle) Or TOechsle = 0 Or TOechsle = "" Then -Else - TQSNR.Value = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(TOechsle) + " AND Bis>=" + Format(TOechsle)) -End If - -If Not IsNull(TSNR) And Not IsNull(TQSNR) And Not IsNull(TZweigstelle) Then - CNR1 = GetActiveCharge(TSNR, TQSNR, TZweigstelle, TSANR) - If CNR1 > 0 Then - TCNR = CNR1 - Else - 'Warnung - If GetParameter("CHARGENWARNUNG") = "Ja" Then - If MsgBox("Es konnte keine Charge im Status 'Befüllung' für diese Übernahme gefunden werden. Wollen Sie eine Charge auswählen bzw. neu anlegen", vbYesNo) = vbYes Then - DoCmd.OpenForm ("FUebernahmeChargenauswahl") - End If - End If - End If -End If - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll - - -End Sub - -Sub RefreshAll() - -Dim w1 - -w1 = TOechsle - -If Not IsNull(w1) And w1 <> "" Then - 'TQualitaetsstufe.Caption = DMax("Bezeichnung", "TQualitaetsstufen", "QSNR=" + Format(TQSNR)) - If TQSNR = 4 Then - OSpaetlese.Visible = True - Else - OSpaetlese.Visible = False - End If - TKW.Caption = "= " + Format((DMax("[KW]", "TUmrechnung", "Oechsle=" + Format(TOechsle)))) + " ° KW" -Else - TKW.Caption = "" -End If - -If Not IsNull(TGNR) Then - TGLNR = DFirst("[GLNR]", "TGemeinden", "GNR=" + Format(TGNR)) - If Not IsNull(TQSNR) And Not IsNull(TSNR) And Not IsNull(TGLNR) Then - TWBGNR = GetGebietGLNR(TSNR, TQSNR, TGLNR) - TRGNR = DFirst("[RGNR]", "TGebiete", "WBGNR=" + Format(TWBGNR)) - End If - - 'TWBGNR = DFirst("[WBGNR]", "TGrosslagen", "GLNR=" + Format(TGLNR)) -End If - - -LBishergeliefert.Requery - -End Sub - - -Private Sub Befehl133_Click() -On Error GoTo Err_Befehl133_Click - - - DoCmd.GoToRecord , , acFirst - -Exit_Befehl133_Click: - Exit Sub - -Err_Befehl133_Click: - MsgBox Err.Description - Resume Exit_Befehl133_Click - -End Sub -Private Sub Befehl134_Click() -On Error GoTo Err_Befehl134_Click - - - DoCmd.GoToRecord , , acPrevious - -Exit_Befehl134_Click: - Exit Sub - -Err_Befehl134_Click: - MsgBox Err.Description - Resume Exit_Befehl134_Click - -End Sub -Private Sub Befehl135_Click() -On Error GoTo Err_Befehl135_Click - - - DoCmd.GoToRecord , , acNext - -Exit_Befehl135_Click: - Exit Sub - -Err_Befehl135_Click: - MsgBox Err.Description - Resume Exit_Befehl135_Click - -End Sub -Private Sub Befehl136_Click() -On Error GoTo Err_Befehl136_Click - - - DoCmd.GoToRecord , , acLast - -Exit_Befehl136_Click: - Exit Sub - -Err_Befehl136_Click: - MsgBox Err.Description - Resume Exit_Befehl136_Click - -End Sub -Private Sub Befehl137_Click() - -On Error GoTo Err_Befehl137_Click - - - DoCmd.GoToRecord , , acNewRec - -Exit_Befehl137_Click: - Exit Sub - -Err_Befehl137_Click: - MsgBox Err.Description - Resume Exit_Befehl137_Click - -TMGNR.SetFocus - - -End Sub -Private Sub Befehl138_Click() - -If MsgBox("Sind Sie sicher, daß Sie diesen Datensatz löschen möchten (ev. stornieren) ?", vbYesNo) = vbYes Then - -On Error GoTo Err_Befehl138_Click - - - DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 - DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70 - -Exit_Befehl138_Click: - Exit Sub - -Err_Befehl138_Click: - MsgBox Err.Description - Resume Exit_Befehl138_Click - - -End If - -End Sub -Private Sub Befehl141_Click() - -If MsgBox("Wollen Sie diese Lieferung wirklich stornieren ?", vbYesNo) = vbYes Then - - If Not IsNull(TCNR) And TGewicht > 0 And TOechsle > 0 Then - If MsgBox("Wollen Sie die Liefermenge bei der zugeordneten Charge ebenfalls abziehen?", vbYesNo) = vbYes Then - ChargeBefuellungRueckgaengig TCNR, TLINR - TCNR = "" - End If - End If - TGewicht = 0 - OStorniert = 1 - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - RefreshAll - -End If - - -End Sub - -Private Sub TSANR_Click() - -'If TSANR.Column(1) = "Sekt" Then -' TQSNR = 0 -'End If - -End Sub - -Private Sub TSNR_Exit(Cancel As Integer) - - - TSNR = UCase(TSNR) - - Dim SNR1 As String - Dim SANR1 As String - - If IsNull(TSNR) Then - Exit Sub - End If - - If GetSNRAndSANRFromInput(TSNR, SNR1, SANR1) Then - TSNR = SNR1 - TSANR = SANR1 - Else - TSANR = Null - End If - - - If DCount("[SNR]", "TSorten", "SNR='" + TSNR + "'") = 0 Then - MsgBox "Bitte geben Sie ein gültiges Sortenkürzel ein!", vbCritical - 'TSNR = - TSNR.SetFocus - Exit Sub - End If - - DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 - - RefreshAll - - - Dim mgnr1 - Dim flageb1 - - mgnr1 = TMGNR - SNR1 = TSNR - - If IsNull(SNR1) Or IsNull(mgnr1) Then - Exit Sub - End If - - flageb1 = DSum("Flaeche", "TFlaechenbindungen", "SNR='" + Format(SNR1) + "' AND MGNR=" + Format(mgnr1)) - - If Not IsNull(flageb1) And flageb1 > 0 Then - OGebunden = True - Else - OGebunden = False - End If - -End Sub - - - - -Sub SetLieferscheinnummer() - -Dim newLieferscheinnummer As String -Dim tag1 As String -Dim mon1 As String -Dim Jahr1 As String -Dim temp1 -Dim lief1 As String -Dim zwst1 As String - -tag1 = Format(Day(TDatum.Value), "00") -mon1 = Format(Month(TDatum.Value), "00") -Jahr1 = Format(year(TDatum.Value), "0000") - -'MsgBox ("[Datum]=DateValue('" + Format(TDatum, "dd.mm.yyyy") + "')") -temp1 = DCount("[LINR]", "TLieferungen", "[Datum]=DateValue('" + Format(TDatum, "dd.mm.yyyy") + "') AND TLieferungen.ZNR=" + Format(TZweigstelle)) -If IsNull(temp1) Then - lief1 = Format(1, "000") -Else - lief1 = Format(temp1, "000") -End If - -zwst1 = DMax("[Kennbst]", "TZweigstellen", "ZNR=" + Format(TZweigstelle)) - -newLieferscheinnummer = Jahr1 + mon1 + tag1 + zwst1 + lief1 - -TLieferscheinnummer = newLieferscheinnummer - -End Sub - - -Public Sub send(ByVal b As Byte) -' Sends 1 Byte to serial interface -Dim buff As Variant -ReDim buff(0 To 0) As Byte - -buff(0) = b - - Forms!FÜbernahme!XComm.Output = buff - - While Forms!FÜbernahme!XComm.OutBufferCount > 0 - Wend - -End Sub - -Public Function Receive() As Integer -' Receives 1 byte from serial interface -' Timeout after 'MPreferences.ICommTimeout' milliseconds - -Dim i As Variant - -On Error GoTo err1 -Forms!FÜbernahme!XComm.InputLen = 1 -TheEvent = 0 - -While Forms!FÜbernahme!XComm.InBufferCount < 1 And TheEvent < 1 - DoEvents - If Forms!FÜbernahme.ActiveControl = False Then - Exit Function - End If -Wend -ReDim i(1) - -If Forms!FÜbernahme!XComm.InBufferCount >= 1 Then - i = Forms!FÜbernahme!XComm.Input - 'MsgBox (i(0)) - Receive = i(0) -Else - Receive = -1 -End If -Exit Function - -err1: - Receive = -1 - -End Function - - - - -Private Sub Befehl186_Click() - -DoCmd.OpenForm "MLieferungSuchen" - -End Sub - -Sub NewLieferschein() - - Dim db1 As Database - Dim rs1 As Recordset - Dim rs2 As Recordset - Dim LINR1 As Long - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("TLieferungen") - rs1.AddNew - If IsNull(DMax("LINR", "TLieferungen")) Then - rs1!LINR = 1 - Else - rs1!LINR = DMax("LINR", "TLieferungen") + 1 - 'rs1!ZNR = DMax("[ZNR]", "TLieferungen", "[LINR]=" + Format(DMax("[LINR]", "TLieferungen", "[LINR]<>" + Format(rs1!LINR)))) - rs1!ZNR = GetParameter("LETZTEZNR") - rs1!Gerebelt = DMax("[Gerebelt]", "TLieferungen", "[LINR]=" + Format(DMax("[LINR]", "TLieferungen", "[LINR]<>" + Format(rs1!LINR)))) - End If - LINR1 = rs1!LINR - rs1!Datum = Date - rs1!Uhrzeit = time - rs1.Update - rs1.Close - - ' Standardabschläge suchen - On Error GoTo EndNew - Set rs1 = db1.OpenRecordset("SELECT * FROM TAbschlaege WHERE Standard=TRUE") - Set rs2 = db1.OpenRecordset("TLieferungAbschlag") - While Not rs1.EOF - rs2.AddNew - rs2!LINR = LINR1 - rs2!ASNR = rs1!ASNR - rs2.Update - rs1.MoveNext - Wend - rs1.Close - rs2.Close - -EndNew: - Requery - DoCmd.GoToRecord acActiveDataObject, , acLast - -End Sub - -Sub LetztenLieferscheinLöschen() - - Dim db1 As Database - Dim rs1 As Recordset - Dim LINR1 - - LINR1 = DMax("LINR", "TLieferungen") - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1)) - rs1.MoveLast - - If rs1!Gewicht = 0 Or IsNull(rs1!Gewicht) Then - LINR1 = rs1!LINR - rs1.Delete - db1.Execute ("DELETE * FROM TLieferungAbschlag WHERE LINR=" + Format(LINR1)) - End If - rs1.Close - - - -End Sub - -Private Sub TZweigstelle_Exit(Cancel As Integer) - -If Not IsNull(TZweigstelle) Then - SetParameter "LETZTEZNR", TZweigstelle -End If - - - -End Sub - - - -Function GetAbschlaege() As Integer - -Dim db1 As Database -Dim rs1 As Recordset -Dim str1 As String - -str1 = "" - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR WHERE LINR = " + Format(TLINR)) -GetAbschlaege = rs1.recordcount -While Not rs1.EOF - str1 = str1 + rs1!Bezeichnung - rs1.MoveNext - If Not rs1.EOF Then - str1 = str1 + Chr(13) + Chr(10) - End If -Wend -rs1.Close - -TAbschlaege = str1 - - -End Function - -Sub SchnellauswahlAnlegen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim max1 As Long -Dim i, j As Long -Dim bs_name As String - -max1 = 4 ' derzeit 4 Buttons - -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TAbschlaege WHERE Schnellauswahl=True") -i = 0 -While Not rs1.EOF And i < max1 - str1 = str1 + rs1!Bezeichnung - bs_name = "BS" + Format(i + 1, "0") - Controls(bs_name).Visible = True - Controls(bs_name).Caption = rs1!Bezeichnung - Controls(bs_name).Tag = rs1!ASNR - i = i + 1 - rs1.MoveNext -Wend -rs1.Close -For j = i To max1 - 1 - bs_name = "BS" + Format(j + 1, "0") - Controls(bs_name).Visible = False -Next j - - -End Sub - - -Sub VollieferantenZuschlagEintragen() - -Dim db1 As Database -Dim rs1 As Recordset -Dim ASNR1 As Long - -max1 = 4 ' derzeit 4 Buttons - -If Not IsNull(TMGNR) Then - If DFirst("Volllieferant", "TMitglieder", "MGNR=" + Format(TMGNR)) = True Then - - If Not IsNull(DFirst("ASNR", "TAbschlaege", "Bezeichnung='Treuebonus'")) Then - ASNR1 = DFirst("ASNR", "TAbschlaege", "Bezeichnung='Treuebonus'") - Set db1 = CurrentDb - - 'Check if this ASNR is already assigned - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR)) - If rs1.recordcount > 0 Then - Exit Sub - rs1.Close - End If - - 'Add to Table TLieferungenAbschlaege - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag") - rs1.AddNew - rs1!LINR = TLINR - rs1!ASNR = ASNR1 - rs1.Update - FAbschlaege.Requery - rs1.Close - End If - End If -End If - - - - -End Sub - diff --git a/wgmaster/vba/form/Form_FÜbernahmeAbschlag.frm b/wgmaster/vba/form/Form_FÜbernahmeAbschlag.frm deleted file mode 100644 index 9e0f5ef..0000000 --- a/wgmaster/vba/form/Form_FÜbernahmeAbschlag.frm +++ /dev/null @@ -1,19 +0,0 @@ -Private Sub LGNR_Exit(Cancel As Integer) - -End Sub -Private Sub Befehl46_Click() -On Error GoTo Err_Befehl46_Click - - Dim stDocName As String - - stDocName = "BAbschlaege" - DoCmd.OpenReport stDocName, acViewPreview - -Exit_Befehl46_Click: - Exit Sub - -Err_Befehl46_Click: - MsgBox Err.Description - Resume Exit_Befehl46_Click - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAbwertungen.frm b/wgmaster/vba/form/Form_MAbwertungen.frm deleted file mode 100644 index 8a8e505..0000000 --- a/wgmaster/vba/form/Form_MAbwertungen.frm +++ /dev/null @@ -1,38 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - -Select Case OListe - -Case 1: - DoCmd.OpenReport "BAbwertungenMGNR", acPreview, , "ZNR=" + Format(Forms!MAbwertungen!TZNR) -Case 2: - DoCmd.OpenReport "BAbwertungen", acPreview, , "ZNR=" + Format(Forms!MAbwertungen!TZNR) -Case 3: - DoCmd.OpenReport "BAbwertungenSorte", acPreview, , "ZNR=" + Format(Forms!MAbwertungen!TZNR) - -End Select - -End Sub - - - - - -Private Sub Form_Open(Cancel As Integer) - -TZNR = DFirst("ZNR", "TZweigstellen") -If Month(Date) < 9 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If -OListe = 1 - -End Sub - diff --git a/wgmaster/vba/form/Form_MAdministration.frm b/wgmaster/vba/form/Form_MAdministration.frm deleted file mode 100644 index 8c2048f..0000000 --- a/wgmaster/vba/form/Form_MAdministration.frm +++ /dev/null @@ -1,328 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Befehl14_Click() - -Dim filename As String -Dim defaultfilename As String -Dim str1 - -If IsNull(GetParameter("UPDATEPATH")) Then - SetParameter "UPDATEPATH", "A:\WGUPDATE.ACCDB" -End If - -defaultfilename = GetParameter("UPDATEPATH") - -'defaultfilename = "D:\PROJEKT\CHRIS\WGMASTER\WGUPDATE.ACCDB" - -filename = InputBox("Geben Sie Bitte den Dateinamen ein: ", "Update einspielen", defaultfilename) - -If Not IsNull(filename) And filename <> "" Then - -SetParameter "UPDATEPATH", filename - -Dim db1 As Database -Dim cnt1 As Container -Dim doc1 As Document - - ' Current Database for SQL Statements -Dim db2 As Database -Dim rs1 As Recordset - - -Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(GetDataPath()) - - On Error GoTo err1 - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - On Error GoTo 0 - For Each cnt1 In db1.Containers - If cnt1.Name = "Forms" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - 'close open forms - If Not IsNull(Form(doc1.Name)) Then - DoCmd.Close acForm, doc1.Name - End If - - DoCmd.DeleteObject acForm, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acForm, doc1.Name, doc1.Name - End If - Next doc1 - End If - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - DoCmd.DeleteObject acReport, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acReport, doc1.Name, doc1.Name - End If - Next doc1 - End If - - If cnt1.Name = "Tables" Then - For Each doc1 In cnt1.Documents - If doc1.Name = "Update_SQLStatements" Then - Set rs1 = db1.OpenRecordset("Update_SQLStatements") - While Not rs1.EOF - If MsgBox(rs1!Beschreibung + " ?", vbYesNo) = vbYes Then - db2.Execute (rs1!SQLStatement) - End If - rs1.MoveNext - Wend - rs1.Close - End If - Next doc1 - End If - - If cnt1.Name = "Modules" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - DoCmd.DeleteObject acModule, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acModule, doc1.Name, doc1.Name - End If - Next doc1 - End If - - - Next cnt1 - -End If - -Exit Sub - -err1: - -MsgBox "FEHLER: Update-Datei nicht gefunden !", vbCritical - -End Sub - -Private Sub Befehl15_Click() - -DoCmd.OpenForm "MImport" - -End Sub - -Private Sub Befehl16_Click() - -DoCmd.OpenForm "MExport" - -End Sub - - - -Private Sub BLogoAkt_Click() - -Dim datapath As String -Dim Data As String - -Data = DMax("[Data]", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten)) -datapath = GetPathWithoutFilename(Data) -If FileSystem.FileLen(datapath + "LOGO.BMP") > 0 Then - SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP" -End If - -End Sub - -Function SetReportControlProperty1(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Variant - -If reportname = "" Or IsNull(reportname) Then -'All Reports - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - If doc1.Name <> "BAuszahlungsvariante" Then - DoCmd.OpenReport doc1.Name, acViewDesign - - On Error Resume Next - 'look into all sections - For i = 0 To 8 - 'If Reports(doc1.Name).Section(i).Visible = True Then - Reports(doc1.Name).Controls(ControlName).Properties(PropertyName) = PropertyValue - 'Set sec1 = Reports(doc1.Name).Section(i) - 'For Each ctl1 In sec1.Controls - 'If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - 'If Controltype = ctl1.Controltype Or Controltype = -1 Then - 'On Error Resume Next - 'ctl1.Properties(PropertyName) = PropertyValue - 'End If - 'End If - 'Next ctl1 - 'End If - Next i - DoCmd.Save - DoCmd.Close - End If - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenReport reportname, acViewDesign - For i = 0 To 8 - Set sec1 = Reports(reportname).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - -Private Sub BOk_Click() - -If LWaagentyp <> "L246" Then - DoCmd.OpenForm "FÜbernahme", acDesign - Forms!FÜbernahme!XComm.Settings = TSettings - Forms!FÜbernahme!XComm.CommPort = LPort - Forms!FÜbernahme!XCommSteuerung.CommPort = LPortSteuerung - DoCmd.Save - DoCmd.Close -End If - -SetParameter "WAAGENTYP", LWaagentyp -SetParameter "STEUERUNGTYP", LSteuerungtyp -SetParameter "WAAGEPORT", LPort -SetParameter "STEUERUNGPORT", LPortSteuerung -SetParameter "WAAGEPORTSETTINGS", TSettings - - -SetParameter "WAAGENMONITORLIMIT", TWaagenmonitorLimit - -If OWaagenmonitor Then - SetParameter "WAAGENMONITOR", "1" -Else - SetParameter "WAAGENMONITOR", "0" -End If - - -DoCmd.Close - -End Sub - -Private Sub Form_Close() - -SetParameter "WAAGENTYP", LWaagentyp - -If LSteuerungtyp = "PARALLEL" Then - SetParameter "STEUERUNGPORT", LLPT -End If - -If LSteuerungtyp = "SERIELL" Then - SetParameter "STEUERUNGPORT", LPortSteuerung -End If - -If LSteuerungtyp = "EXTERN" Then - SetParameter "STEUERUNGEXTERN", TExtern -End If - -End Sub - -Private Sub Form_Open(Cancel As Integer) - - -'DoCmd.OpenForm "FÜbernahme", acDesign - -'TSettings = Forms!FÜbernahme!XComm.Settings -'LPort = Forms!FÜbernahme!XComm.CommPort -'LPortSteuerung = Forms!FÜbernahme!XCommSteuerung.CommPort -TSettings = GetParameter("WAAGEPORTSETTINGS") -LPort = GetParameter("WAAGEPORT") -LPortSteuerung = GetParameter("STEUERUNGPORT") - -'DoCmd.Save -'DoCmd.Close - -LWaagentyp = GetParameter("WAAGENTYP") -LSteuerungtyp = GetParameter("STEUERUNGTYP") - -Dim host As String -Dim tcpport As Long - -If IsNull(GetParameter("WAAGEHOST")) Then - SetParameter "WAAGEHOST", "10.0.0.80" - SetParameter "WAAGETCPPORT", "1234" -End If - -host = GetParameter("WAAGEHOST") -tcpport = GetParameter("WAAGETCPPORT") - - - -If LSteuerungtyp = "SERIELL" Then - LPortSteuerung.Visible = True - XPortSteuerung.Visible = True - LPortSteuerung = GetParameter("STEUERUNGPORT") -Else - LPortSteuerung.Visible = False - XPortSteuerung.Visible = False -End If - -If LSteuerungtyp = "PARALLEL" Then - LLPT.Visible = True - XLPT.Visible = True - LLPT = GetParameter("STEUERUNGPORT") -Else - LLPT.Visible = False - XLPT.Visible = False -End If - -If LSteuerungtyp = "EXTERN" Then - TExtern.Visible = True - TExtern = GetParameter("STEUERUNGEXTERN") -Else - TExtern.Visible = False -End If - -TWaagenmonitorLimit = GetParameter("WAAGENMONITORLIMIT") -If GetParameter("WAAGENMONITOR") = "1" Then - OWaagenmonitor = True -Else - OWaagenmonitor = False -End If - -End Sub - -Private Sub LSteuerungtyp_Click() - -If LSteuerungtyp = "SERIELL" Then - LPortSteuerung.Visible = True - XPortSteuerung.Visible = True -Else - LPortSteuerung.Visible = False - XPortSteuerung.Visible = False -End If - -If LSteuerungtyp = "PARALLEL" Then - LLPT.Visible = True - XLPT.Visible = True -Else - LLPT.Visible = False - XLPT.Visible = False -End If - -If LSteuerungtyp = "EXTERN" Then - TExtern.Visible = True -Else - TExtern.Visible = False -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAdministrationCopy.frm b/wgmaster/vba/form/Form_MAdministrationCopy.frm deleted file mode 100644 index 8c2048f..0000000 --- a/wgmaster/vba/form/Form_MAdministrationCopy.frm +++ /dev/null @@ -1,328 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Befehl14_Click() - -Dim filename As String -Dim defaultfilename As String -Dim str1 - -If IsNull(GetParameter("UPDATEPATH")) Then - SetParameter "UPDATEPATH", "A:\WGUPDATE.ACCDB" -End If - -defaultfilename = GetParameter("UPDATEPATH") - -'defaultfilename = "D:\PROJEKT\CHRIS\WGMASTER\WGUPDATE.ACCDB" - -filename = InputBox("Geben Sie Bitte den Dateinamen ein: ", "Update einspielen", defaultfilename) - -If Not IsNull(filename) And filename <> "" Then - -SetParameter "UPDATEPATH", filename - -Dim db1 As Database -Dim cnt1 As Container -Dim doc1 As Document - - ' Current Database for SQL Statements -Dim db2 As Database -Dim rs1 As Recordset - - -Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(GetDataPath()) - - On Error GoTo err1 - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - On Error GoTo 0 - For Each cnt1 In db1.Containers - If cnt1.Name = "Forms" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - 'close open forms - If Not IsNull(Form(doc1.Name)) Then - DoCmd.Close acForm, doc1.Name - End If - - DoCmd.DeleteObject acForm, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acForm, doc1.Name, doc1.Name - End If - Next doc1 - End If - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - DoCmd.DeleteObject acReport, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acReport, doc1.Name, doc1.Name - End If - Next doc1 - End If - - If cnt1.Name = "Tables" Then - For Each doc1 In cnt1.Documents - If doc1.Name = "Update_SQLStatements" Then - Set rs1 = db1.OpenRecordset("Update_SQLStatements") - While Not rs1.EOF - If MsgBox(rs1!Beschreibung + " ?", vbYesNo) = vbYes Then - db2.Execute (rs1!SQLStatement) - End If - rs1.MoveNext - Wend - rs1.Close - End If - Next doc1 - End If - - If cnt1.Name = "Modules" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - DoCmd.DeleteObject acModule, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acModule, doc1.Name, doc1.Name - End If - Next doc1 - End If - - - Next cnt1 - -End If - -Exit Sub - -err1: - -MsgBox "FEHLER: Update-Datei nicht gefunden !", vbCritical - -End Sub - -Private Sub Befehl15_Click() - -DoCmd.OpenForm "MImport" - -End Sub - -Private Sub Befehl16_Click() - -DoCmd.OpenForm "MExport" - -End Sub - - - -Private Sub BLogoAkt_Click() - -Dim datapath As String -Dim Data As String - -Data = DMax("[Data]", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten)) -datapath = GetPathWithoutFilename(Data) -If FileSystem.FileLen(datapath + "LOGO.BMP") > 0 Then - SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP" -End If - -End Sub - -Function SetReportControlProperty1(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Variant - -If reportname = "" Or IsNull(reportname) Then -'All Reports - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - If doc1.Name <> "BAuszahlungsvariante" Then - DoCmd.OpenReport doc1.Name, acViewDesign - - On Error Resume Next - 'look into all sections - For i = 0 To 8 - 'If Reports(doc1.Name).Section(i).Visible = True Then - Reports(doc1.Name).Controls(ControlName).Properties(PropertyName) = PropertyValue - 'Set sec1 = Reports(doc1.Name).Section(i) - 'For Each ctl1 In sec1.Controls - 'If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - 'If Controltype = ctl1.Controltype Or Controltype = -1 Then - 'On Error Resume Next - 'ctl1.Properties(PropertyName) = PropertyValue - 'End If - 'End If - 'Next ctl1 - 'End If - Next i - DoCmd.Save - DoCmd.Close - End If - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenReport reportname, acViewDesign - For i = 0 To 8 - Set sec1 = Reports(reportname).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - -Private Sub BOk_Click() - -If LWaagentyp <> "L246" Then - DoCmd.OpenForm "FÜbernahme", acDesign - Forms!FÜbernahme!XComm.Settings = TSettings - Forms!FÜbernahme!XComm.CommPort = LPort - Forms!FÜbernahme!XCommSteuerung.CommPort = LPortSteuerung - DoCmd.Save - DoCmd.Close -End If - -SetParameter "WAAGENTYP", LWaagentyp -SetParameter "STEUERUNGTYP", LSteuerungtyp -SetParameter "WAAGEPORT", LPort -SetParameter "STEUERUNGPORT", LPortSteuerung -SetParameter "WAAGEPORTSETTINGS", TSettings - - -SetParameter "WAAGENMONITORLIMIT", TWaagenmonitorLimit - -If OWaagenmonitor Then - SetParameter "WAAGENMONITOR", "1" -Else - SetParameter "WAAGENMONITOR", "0" -End If - - -DoCmd.Close - -End Sub - -Private Sub Form_Close() - -SetParameter "WAAGENTYP", LWaagentyp - -If LSteuerungtyp = "PARALLEL" Then - SetParameter "STEUERUNGPORT", LLPT -End If - -If LSteuerungtyp = "SERIELL" Then - SetParameter "STEUERUNGPORT", LPortSteuerung -End If - -If LSteuerungtyp = "EXTERN" Then - SetParameter "STEUERUNGEXTERN", TExtern -End If - -End Sub - -Private Sub Form_Open(Cancel As Integer) - - -'DoCmd.OpenForm "FÜbernahme", acDesign - -'TSettings = Forms!FÜbernahme!XComm.Settings -'LPort = Forms!FÜbernahme!XComm.CommPort -'LPortSteuerung = Forms!FÜbernahme!XCommSteuerung.CommPort -TSettings = GetParameter("WAAGEPORTSETTINGS") -LPort = GetParameter("WAAGEPORT") -LPortSteuerung = GetParameter("STEUERUNGPORT") - -'DoCmd.Save -'DoCmd.Close - -LWaagentyp = GetParameter("WAAGENTYP") -LSteuerungtyp = GetParameter("STEUERUNGTYP") - -Dim host As String -Dim tcpport As Long - -If IsNull(GetParameter("WAAGEHOST")) Then - SetParameter "WAAGEHOST", "10.0.0.80" - SetParameter "WAAGETCPPORT", "1234" -End If - -host = GetParameter("WAAGEHOST") -tcpport = GetParameter("WAAGETCPPORT") - - - -If LSteuerungtyp = "SERIELL" Then - LPortSteuerung.Visible = True - XPortSteuerung.Visible = True - LPortSteuerung = GetParameter("STEUERUNGPORT") -Else - LPortSteuerung.Visible = False - XPortSteuerung.Visible = False -End If - -If LSteuerungtyp = "PARALLEL" Then - LLPT.Visible = True - XLPT.Visible = True - LLPT = GetParameter("STEUERUNGPORT") -Else - LLPT.Visible = False - XLPT.Visible = False -End If - -If LSteuerungtyp = "EXTERN" Then - TExtern.Visible = True - TExtern = GetParameter("STEUERUNGEXTERN") -Else - TExtern.Visible = False -End If - -TWaagenmonitorLimit = GetParameter("WAAGENMONITORLIMIT") -If GetParameter("WAAGENMONITOR") = "1" Then - OWaagenmonitor = True -Else - OWaagenmonitor = False -End If - -End Sub - -Private Sub LSteuerungtyp_Click() - -If LSteuerungtyp = "SERIELL" Then - LPortSteuerung.Visible = True - XPortSteuerung.Visible = True -Else - LPortSteuerung.Visible = False - XPortSteuerung.Visible = False -End If - -If LSteuerungtyp = "PARALLEL" Then - LLPT.Visible = True - XLPT.Visible = True -Else - LLPT.Visible = False - XLPT.Visible = False -End If - -If LSteuerungtyp = "EXTERN" Then - TExtern.Visible = True -Else - TExtern.Visible = False -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAdministrationCopy2.frm b/wgmaster/vba/form/Form_MAdministrationCopy2.frm deleted file mode 100644 index 2074fbb..0000000 --- a/wgmaster/vba/form/Form_MAdministrationCopy2.frm +++ /dev/null @@ -1,326 +0,0 @@ -Option Compare Database -Option Explicit - -Private Sub Befehl14_Click() - -Dim filename As String -Dim defaultfilename As String -Dim str1 - -If IsNull(GetParameter("UPDATEPATH")) Then - SetParameter "UPDATEPATH", "A:\WGUPDATE.ACCDB" -End If - -defaultfilename = GetParameter("UPDATEPATH") - -'defaultfilename = "D:\PROJEKT\CHRIS\WGMASTER\WGUPDATE.ACCDB" - -filename = InputBox("Geben Sie Bitte den Dateinamen ein: ", "Update einspielen", defaultfilename) - -If Not IsNull(filename) And filename <> "" Then - -SetParameter "UPDATEPATH", filename - -Dim db1 As Database -Dim cnt1 As Container -Dim doc1 As Document - - ' Current Database for SQL Statements -Dim db2 As Database -Dim rs1 As Recordset - - -Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(GetDataPath()) - - On Error GoTo err1 - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - On Error GoTo 0 - For Each cnt1 In db1.Containers - If cnt1.Name = "Forms" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - 'close open forms - If Not IsNull(Form(doc1.Name)) Then - DoCmd.Close acForm, doc1.Name - End If - - DoCmd.DeleteObject acForm, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acForm, doc1.Name, doc1.Name - End If - Next doc1 - End If - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - DoCmd.DeleteObject acReport, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acReport, doc1.Name, doc1.Name - End If - Next doc1 - End If - - If cnt1.Name = "Tables" Then - For Each doc1 In cnt1.Documents - If doc1.Name = "Update_SQLStatements" Then - Set rs1 = db1.OpenRecordset("Update_SQLStatements") - While Not rs1.EOF - If MsgBox(rs1!Beschreibung + " ?", vbYesNo) = vbYes Then - db2.Execute (rs1!SQLStatement) - End If - rs1.MoveNext - Wend - rs1.Close - End If - Next doc1 - End If - - If cnt1.Name = "Modules" Then - For Each doc1 In cnt1.Documents - If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then - On Error Resume Next - DoCmd.DeleteObject acModule, doc1.Name - DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acModule, doc1.Name, doc1.Name - End If - Next doc1 - End If - - - Next cnt1 - -End If - -Exit Sub - -err1: - -MsgBox "FEHLER: Update-Datei nicht gefunden !", vbCritical - -End Sub - -Private Sub Befehl15_Click() - -DoCmd.OpenForm "MImport" - -End Sub - -Private Sub Befehl16_Click() - -DoCmd.OpenForm "MExport" - -End Sub - - - -Private Sub BLogoAkt_Click() - -Dim datapath As String -Dim Data As String - -Data = DMax("[Data]", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten)) -datapath = GetPathWithoutFilename(Data) -If FileSystem.FileLen(datapath + "LOGO.BMP") > 0 Then - SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP" -End If - -End Sub - -Function SetReportControlProperty1(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Variant - -If reportname = "" Or IsNull(reportname) Then -'All Reports - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenReport doc1.Name, acViewDesign - - On Error Resume Next - 'look into all sections - For i = 0 To 8 - 'If Reports(doc1.Name).Section(i).Visible = True Then - Reports(doc1.Name).Controls(ControlName).Properties(PropertyName) = PropertyValue - 'Set sec1 = Reports(doc1.Name).Section(i) - 'For Each ctl1 In sec1.Controls - 'If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - 'If Controltype = ctl1.Controltype Or Controltype = -1 Then - 'On Error Resume Next - 'ctl1.Properties(PropertyName) = PropertyValue - 'End If - 'End If - 'Next ctl1 - 'End If - Next i - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenReport reportname, acViewDesign - For i = 0 To 8 - Set sec1 = Reports(reportname).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close -End If - -End Function - -Private Sub BOk_Click() - -If LWaagentyp <> "L246" Then - DoCmd.OpenForm "FÜbernahme", acDesign - Forms!FÜbernahme!XComm.Settings = TSettings - Forms!FÜbernahme!XComm.CommPort = LPort - Forms!FÜbernahme!XCommSteuerung.CommPort = LPortSteuerung - DoCmd.Save - DoCmd.Close -End If - -SetParameter "WAAGENTYP", LWaagentyp -SetParameter "STEUERUNGTYP", LSteuerungtyp -SetParameter "WAAGEPORT", LPort -SetParameter "STEUERUNGPORT", LPortSteuerung -SetParameter "WAAGEPORTSETTINGS", TSettings - - -SetParameter "WAAGENMONITORLIMIT", TWaagenmonitorLimit - -If OWaagenmonitor Then - SetParameter "WAAGENMONITOR", "1" -Else - SetParameter "WAAGENMONITOR", "0" -End If - - -DoCmd.Close - -End Sub - -Private Sub Form_Close() - -SetParameter "WAAGENTYP", LWaagentyp - -If LSteuerungtyp = "PARALLEL" Then - SetParameter "STEUERUNGPORT", LLPT -End If - -If LSteuerungtyp = "SERIELL" Then - SetParameter "STEUERUNGPORT", LPortSteuerung -End If - -If LSteuerungtyp = "EXTERN" Then - SetParameter "STEUERUNGEXTERN", TExtern -End If - -End Sub - -Private Sub Form_Open(Cancel As Integer) - - -'DoCmd.OpenForm "FÜbernahme", acDesign - -'TSettings = Forms!FÜbernahme!XComm.Settings -'LPort = Forms!FÜbernahme!XComm.CommPort -'LPortSteuerung = Forms!FÜbernahme!XCommSteuerung.CommPort -TSettings = GetParameter("WAAGEPORTSETTINGS") -LPort = GetParameter("WAAGEPORT") -LPortSteuerung = GetParameter("STEUERUNGPORT") - -'DoCmd.Save -'DoCmd.Close - -LWaagentyp = GetParameter("WAAGENTYP") -LSteuerungtyp = GetParameter("STEUERUNGTYP") - -Dim host As String -Dim tcpport As Long - -If IsNull(GetParameter("WAAGEHOST")) Then - SetParameter "WAAGEHOST", "10.0.0.80" - SetParameter "WAAGETCPPORT", "1234" -End If - -host = GetParameter("WAAGEHOST") -tcpport = GetParameter("WAAGETCPPORT") - - - -If LSteuerungtyp = "SERIELL" Then - LPortSteuerung.Visible = True - XPortSteuerung.Visible = True - LPortSteuerung = GetParameter("STEUERUNGPORT") -Else - LPortSteuerung.Visible = False - XPortSteuerung.Visible = False -End If - -If LSteuerungtyp = "PARALLEL" Then - LLPT.Visible = True - XLPT.Visible = True - LLPT = GetParameter("STEUERUNGPORT") -Else - LLPT.Visible = False - XLPT.Visible = False -End If - -If LSteuerungtyp = "EXTERN" Then - TExtern.Visible = True - TExtern = GetParameter("STEUERUNGEXTERN") -Else - TExtern.Visible = False -End If - -TWaagenmonitorLimit = GetParameter("WAAGENMONITORLIMIT") -If GetParameter("WAAGENMONITOR") = "1" Then - OWaagenmonitor = True -Else - OWaagenmonitor = False -End If - -End Sub - -Private Sub LSteuerungtyp_Click() - -If LSteuerungtyp = "SERIELL" Then - LPortSteuerung.Visible = True - XPortSteuerung.Visible = True -Else - LPortSteuerung.Visible = False - XPortSteuerung.Visible = False -End If - -If LSteuerungtyp = "PARALLEL" Then - LLPT.Visible = True - XLPT.Visible = True -Else - LLPT.Visible = False - XLPT.Visible = False -End If - -If LSteuerungtyp = "EXTERN" Then - TExtern.Visible = True -Else - TExtern.Visible = False -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAnlieferung.frm b/wgmaster/vba/form/Form_MAnlieferung.frm deleted file mode 100644 index cc4052d..0000000 --- a/wgmaster/vba/form/Form_MAnlieferung.frm +++ /dev/null @@ -1,113 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - - -Dim v1, b1 -Dim filter1 - -If Not IsNull(TVon) Then - GebundenBerechnen year(TVon), OSortenattributeBeiFlächenbindungOptional, OGebunden -Else - If Not IsNull(TBis) Then - GebundenBerechnen year(TBis), OSortenattributeBeiFlächenbindungOptional, OGebunden - End If -End If - -SetParameter "ANLIEFTEXT", TFusstext.Value - -If IsNull(TVon1) Then - v1 = 0 -Else - v1 = TVon1 -End If - -If IsNull(TBis1) Then - b1 = 999999 -Else - b1 = TBis1 -End If - - -filter1 = "Storniert=False AND " - -If IsNull(TZNR) Or TZNR = "" Then -Else - filter1 = filter1 + "[ZNR]=" + Format(TZNR) + " AND " -End If - - - -If IsNull(TVon) Or TVon = "" Then -Else - filter1 = filter1 + "Datum>=Datevalue('" + Format(TVon) + "') AND " -End If - -If IsNull(TBis) Or TBis = "" Then -Else - filter1 = filter1 + "Datum<=Datevalue('" + Format(TBis) + "') AND " -End If - -Select Case OListe - -Case 1: - filter1 = filter1 + "MGNR>=" + Format(v1) + " AND MGNR<=" + Format(b1) - 'MsgBox (filter1) - DoCmd.OpenReport "BAnlieferungsbestaetigungMGNR", acPreview, , filter1 -Case 2: - filter1 = filter1 + "PLZ>='" + Format(v1) + "' AND PLZ<='" + Format(b1) + "'" - 'MsgBox (filter1) - DoCmd.OpenReport "BAnlieferungsbestaetigung", acPreview, , filter1 - -End Select - -DoCmd.Maximize - - -End Sub - -Private Sub BTagWeiter_Click() - -TVon = DateValue("01.09." + Format(year(TVon) + 1)) -TBis = DateValue("01.11." + Format(year(TBis) + 1)) - -End Sub - -Private Sub BTagZurueck_Click() - -TVon = DateValue("01.09." + Format(year(TVon) - 1)) -TBis = DateValue("01.11." + Format(year(TBis) - 1)) - -End Sub - - - -Private Sub Form_Open(Cancel As Integer) - -OListe = 1 -TVon = DateValue("01.09." + Format(year(Date))) -TBis = DateValue("01.11." + Format(year(Date))) -'TZNR = DFirst("ZNR", "TZweigstellen") -TFusstext = GetParameter("ANLIEFTEXT") -OSortenattributeBeiFlächenbindungOptional = False - -End Sub - - - - -Private Sub TFusstext_Exit(Cancel As Integer) - -If IsNull(TFusstext.Value) Then - SetParameter "ANLIEFTEXT", " " -Else - SetParameter "ANLIEFTEXT", TFusstext.Value -End If - -End Sub - diff --git a/wgmaster/vba/form/Form_MAnlieferungenJahresvergleich.frm b/wgmaster/vba/form/Form_MAnlieferungenJahresvergleich.frm deleted file mode 100644 index 7ad9795..0000000 --- a/wgmaster/vba/form/Form_MAnlieferungenJahresvergleich.frm +++ /dev/null @@ -1,137 +0,0 @@ -Dim filter1 As String - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BDetailliert_Click() - -If IsNull(TVon) Then - MsgBox ("Bitte geben Sie im Feld 'Von' das Startjahr der Auswertung ein") - Exit Sub -End If - -If IsNull(TBis) Then - MsgBox ("Bitte geben Sie im Feld 'Bis' das Endjahr der Auswertung ein") - Exit Sub -End If - -SetFilter - -DoCmd.OpenReport "BAnlieferungenJahresvergleichDetail", acViewPreview, , filter1 - -DoCmd.Maximize - - -End Sub - -Private Sub BOk_Click() - -If IsNull(TVon) Then - MsgBox ("Bitte geben Sie im Feld 'Von' das Startjahr der Auswertung ein") - Exit Sub -End If - -If IsNull(TBis) Then - MsgBox ("Bitte geben Sie im Feld 'Bis' das Endjahr der Auswertung ein") - Exit Sub -End If - -SetFilter -'MsgBox (filter1) - -DoCmd.OpenReport "BAnlieferungenJahresVergleichDetail", acViewPreview, , filter1 - -DoCmd.Maximize - -End Sub - -Sub SetFilter() - - -filter1 = "Storniert=False AND " - -If IsNull(TZNR) Or TZNR = "" Then -Else - filter1 = filter1 + "[ZNR]=" + Format(TZNR) + " AND " -End If - -If IsNull(TVon) Or TVon = "" Then -Else - filter1 = filter1 + "Year(Datum)>=" + Format(TVon) + " AND " -End If - -If IsNull(TBis) Or TBis = "" Then -Else - filter1 = filter1 + "Year(Datum)<=" + Format(TBis) + " AND " -End If - -If IsNull(TSNR) Or TSNR = "" Then -Else - filter1 = filter1 + "SNR='" + Format(TSNR) + "' AND " -End If - -If IsNull(TSANR) Or TSANR = "" Then -Else - filter1 = filter1 + "SANR='" + Format(TSANR) + "' AND " -End If - - -If OAktiveMitglieder = True Then - filter1 = filter1 + "[Aktives Mitglied]=True AND " -End If - - -If IsNull(TVon1) Then - v1 = 0 -Else - v1 = TVon1 -End If - -If IsNull(TBis1) Then - b1 = 999999 -Else - b1 = TBis1 -End If - - -Select Case OListe -Case 1: - - filter1 = filter1 + "MGNR>=" + Format(v1) + " AND MGNR<=" + Format(b1) - 'MsgBox (filter1) -Case 2: - filter1 = filter1 + "PLZ>='" + Format(v1) + "' AND PLZ<='" + Format(b1) + "'" - 'MsgBox (filter1) -End Select - - - - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -OListe = 1 -TVon = year(Date) - 5 -TBis = year(Date) -OSortenattributeBeiFlächenbindungOptional = False -OAktiveMitglieder = True - -End Sub - - - - -Private Sub TFusstext_Exit(Cancel As Integer) - -If IsNull(TFusstext.Value) Then - SetParameter "ANLIEFTEXT", " " -Else - SetParameter "ANLIEFTEXT", TFusstext.Value -End If - -End Sub - diff --git a/wgmaster/vba/form/Form_MAuswertung.frm b/wgmaster/vba/form/Form_MAuswertung.frm deleted file mode 100644 index 7013152..0000000 --- a/wgmaster/vba/form/Form_MAuswertung.frm +++ /dev/null @@ -1,37 +0,0 @@ -Private Sub BBKIListe_Click() - -DoCmd.OpenForm "MExportBKIListe" - -End Sub - -Private Sub Befehl17_Click() - -DoCmd.OpenForm "MAuswertungMitglieder" - - -End Sub - -Private Sub Befehl18_Click() - -DoCmd.OpenForm "MLeseauswertung" - -End Sub - -Private Sub Befehl23_Click() - -DoCmd.OpenForm "MAbwertungen" - -End Sub - -Private Sub Befehl24_Click() - -'DoCmd.OpenReport "BÜberlieferungen", acViewPreview -DoCmd.OpenForm "MUnterlieferungen" - -End Sub - -Private Sub BJahresvergleich_Click() - -DoCmd.OpenForm "MAnlieferungenJahresvergleich" - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAuswertungMitglieder.frm b/wgmaster/vba/form/Form_MAuswertungMitglieder.frm deleted file mode 100644 index d2c2c0f..0000000 --- a/wgmaster/vba/form/Form_MAuswertungMitglieder.frm +++ /dev/null @@ -1,129 +0,0 @@ -Private Sub Befehl19_Click() - -DoCmd.OpenReport "BFlaechenbindungen", acViewPreview - -End Sub - -Private Sub BJahrMinus_Click() - -If Not IsNull(TJahr) Then - TJahr = TJahr - 1 - RefreshAll -End If - -End Sub - -Private Sub BJAhrPlus_Click() - -If Not IsNull(TJahr) Then - TJahr = TJahr + 1 - RefreshAll -End If - -End Sub - -Private Sub BKonsistenzprüfung_Click() - -DoCmd.OpenForm ("MMitgliederKonsistenz") - -End Sub - -Private Sub BVolllieferanten_Click() - -DoCmd.OpenReport "BMitgliederlisteVolllieferanten", acViewPreview - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -TJahr = year(Date) -RefreshAll - -End Sub - - - -Private Sub RefreshAll() - -filter1 = GetFilter -filter2 = " AND [Aktives Mitglied]=True AND ( Year(Eintrittsdatum)<=" + Format(Forms!MAuswertungMitglieder!TJahr) + " OR Isnull(Eintrittsdatum)) " + " AND (Year(Austrittsdatum)>=" + Format(Forms!MAuswertungMitglieder!TJahr) + " OR Isnull(Austrittsdatum))" - -'TAnzahlAktiveMitglieder -TAnzahlAktiveMitglieder = DCount("MGNR", "TMitglieder", "MGNR>=0 " + filter1 + filter2) - -'TGA1 - -TGA1 = DSum("[Geschäftsanteile1]", "TMitglieder", "MGNR>=0 " + filter1 + filter2) - - -'TAnzahlFlaechengebundeneMitglieder - -TAnzahlFlaechengebundeneMitglieder = DCount("TMitglieder.MGNR", "TMitglieder", "MGNR IN (SELECT DISTINCT TMitglieder.MGNR FROM TMitglieder INNER JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR WHERE TFlaechenbindungen.Von<= " + Format(Forms!MAuswertungMitglieder!TJahr) + " AND (TFlaechenbindungen.Bis>=" + Format(Forms!MAuswertungMitglieder!TJahr) + " OR isnull(TFlaechenbindungen.Bis))) " + filter1) - - -'TVollmitglieder - -TVollmitglieder = DCount("MGNR", "TMitglieder", "[Volllieferant]=True" + filter1 + filter2) - - -'TGebundeneFlaecheGesamt - -'TGebundeneFlaecheGesamt = DSum("Flaeche", "TFlaechenbindungen", "MGNR IN (SELECT DISTINCT TMitglieder.MGNR FROM TMitglieder INNER JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR WHERE TFlaechenbindungen.Von<=" + Format(Forms!MAuswertungMitglieder!TJahr) + " AND (TFlaechenbindungen.Bis>=" + Format(Forms!MAuswertungMitglieder!TJahr) + " OR isnull(TFlaechenbindungen.Bis)) " + filter1 + " ) ") -TGebundeneFlaecheGesamt = GetGebundeneFlächeGesamt(filter1) - - -'LFlaechenbindungen - -Dim query1 As String - - -query1 = "SELECT DISTINCT TSorten.Bezeichnung, Sum(TFlaechenbindungen.Flaeche) AS [Gesamtflaeche] FROM (TMitglieder INNER JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR) INNER JOIN TSorten ON TFlaechenbindungen.SNR = TSorten.SNR WHERE TFlaechenbindungen.Von<=" + Format(Forms!MAuswertungMitglieder!TJahr) + " AND (TFlaechenbindungen.Bis >= " + Format(Forms!MAuswertungMitglieder!TJahr) + " OR isnull(TFlaechenbindungen.Bis)) " + filter1 + " GROUP BY TSorten.Bezeichnung;" - -LFlaechenbindungen.RowSource = query1 -LFlaechenbindungen.Requery - - - -End Sub - -Function GetGebundeneFlächeGesamt(filter) As Double - -Dim db1 As Database -Dim rs1 As Recordset -Dim year As String -Dim fb As Double -Set db1 = CurrentDb -year = Format(Forms!MAuswertungMitglieder!TJahr) - -fb = 0 -Set rs1 = db1.OpenRecordset("SELECT * FROM TMitglieder INNER JOIN TFlaechenbindungen ON TMitglieder.MGNR=TFlaechenbindungen.MGNR WHERE [Aktives Mitglied]=True AND (Von<=" + year + " or Von=Null) AND (Bis>=" + year + " or Bis=Null) " + filter) -While Not rs1.EOF - If Not IsNull(rs1("Flaeche")) Then - fb = fb + rs1("Flaeche") - End If -rs1.MoveNext -Wend -rs1.Close - -GetGebundeneFlächeGesamt = fb - -End Function - -Function GetFilter() As String - -If IsNull(TZNR) Or TZNR = "" Or TZNR <= 0 Then - GetFilter = "" -Else - GetFilter = " AND ZNR=" + Format(TZNR) -End If - - -End Function - -Private Sub TZNR_Change() - -RefreshAll - - - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAuszahlung.frm b/wgmaster/vba/form/Form_MAuszahlung.frm deleted file mode 100644 index 1c8b777..0000000 --- a/wgmaster/vba/form/Form_MAuszahlung.frm +++ /dev/null @@ -1,29 +0,0 @@ -Private Sub BBereinigungLieferungen_Click() - -DoCmd.OpenForm "MLieferscheinBereinigung" - -End Sub - -Private Sub Befehl17_Click() - -DoCmd.OpenForm "MAuszahlungAuswahl" - -End Sub - -Private Sub Befehl18_Click() - -DoCmd.OpenForm "MAnlieferung" - -End Sub - -Private Sub Befehl23_Click() - -DoCmd.OpenForm "MStammblatt" - -End Sub - -Private Sub Befehl24_Click() - -DoCmd.OpenForm "MRundschreiben" - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MAuszahlungAuswahl.frm b/wgmaster/vba/form/Form_MAuszahlungAuswahl.frm deleted file mode 100644 index 71acf48..0000000 --- a/wgmaster/vba/form/Form_MAuszahlungAuswahl.frm +++ /dev/null @@ -1,515 +0,0 @@ - -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 diff --git a/wgmaster/vba/form/Form_MChargenAuswahl.frm b/wgmaster/vba/form/Form_MChargenAuswahl.frm deleted file mode 100644 index 645cd20..0000000 --- a/wgmaster/vba/form/Form_MChargenAuswahl.frm +++ /dev/null @@ -1,251 +0,0 @@ - -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 \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MChargenListe.frm b/wgmaster/vba/form/Form_MChargenListe.frm deleted file mode 100644 index c02b9bc..0000000 --- a/wgmaster/vba/form/Form_MChargenListe.frm +++ /dev/null @@ -1,263 +0,0 @@ - - -Private Sub BOk_Click() - -Dim filter1 As String - -filter1 = GetFilter - -DoCmd.OpenReport "BChargenListe", acDesign -If ODetailLieferungen Then - Reports("BChargenListe").Section(0).Visible = True -Else - Reports("BChargenListe").Section(0).Visible = False -End If -DoCmd.Save -DoCmd.Close - - -DoCmd.OpenReport "BChargenListe", acPreview, , filter1 - -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) - -TVon = Date -TBis = Date -'TZNR = DFirst("ZNR", "TZweigstellen") -ODetailLieferungen = False - -End Sub - - -Private Sub OListe_Click() - -RefreshAll - -End Sub - -Private Sub Kombinationsfeld85_Click() -RefreshAll - -End Sub - -Private Sub Kombinationsfeld85_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Private Sub TBis_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Private Sub TBNR_Click() - -RefreshAll - -End Sub - -Private Sub TBNR_Exit(Cancel As Integer) -RefreshAll - -End Sub - -Private Sub TBSNR_Click() - -RefreshAll - -End Sub - -Private Sub TBSNR_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Private Sub TCSNR_Click() - -RefreshAll - -End Sub - -Private Sub TCSNR_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Private Sub TSANR_Click() -RefreshAll - -End Sub - -Private Sub TSANR_Exit(Cancel As Integer) -RefreshAll - -End Sub - -Private Sub TSNR_Click() -RefreshAll - -End Sub - -Private Sub TSNR_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Private Sub TVon_Exit(Cancel As Integer) - -RefreshAll - -End Sub - - -Function GetFilter() - -Dim filter1 As String -Dim hk As String - -If IsNull(TZNR) Then - filter1 = " TChargen.CNR>0 " -Else - filter1 = " TChargen.ZNR=" + Format(Forms!MChargenListe!TZNR) -End If - -filter1 = filter1 + " AND [Befuellungsbeginn]>=Datevalue('" + Format([TVon], "dd.mm.yyyy") + "') AND [Befuellungsbeginn]<=Datevalue('" + Format([TBis], "dd.mm.yyyy") + "')" - -If Not IsNull(TCSNR) And TCSNR > 0 Then - filter1 = filter1 + " AND TChargen.CSNR=" + Format(TCSNR) -End If - -If Not IsNull(TBNR) And TBNR > 0 Then - filter1 = filter1 + " AND TChargen.BNR=" + Format(TBNR) -End If - -If Not IsNull(TBSNR) And TBSNR > 0 Then - filter1 = filter1 + " AND TBehaelter.BSNR=" + Format(TBSNR) -End If - -If Not IsNull(TSNR) And TSNR <> "" Then - filter1 = filter1 + " AND TChargen.SNR='" + Format(TSNR) + "'" -End If - -If Not IsNull(TSANR) And TSANR <> "" Then - filter1 = filter1 + " AND TChargen.SANR='" + Format(TSANR) + "'" -End If - -'MsgBox (filter1) - - GetFilter = filter1 - - -End Function - -Sub RefreshAll() - - -Dim where2, where3 - - -'If TZNR.ListIndex >= 0 Then -'where2 = " AND [TLieferungen].[ZNR]=[Formulare]![MLeseauswertung].[TZNR] " -'Else -'where2 = "" - - -'CalculateSums (where2) -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) And TZNR > 0 Then - Beschreibung = Beschreibung + "Zweigstelle=" + DFirst("Name", "TZweigstellen", "ZNR=" + Format(TZNR)) + ", " -End If - -If Not IsNull(TCSNR) And TCSNR > 0 Then - Beschreibung = Beschreibung + " Status = " + DFirst("ChargenStatus", "TChargenStatus", "CSNR=" + Format(TCSNR)) + ", " -End If - -If Not IsNull(TBNR) And TBNR > 0 Then - Beschreibung = Beschreibung + " Behälter = " + DFirst("Kurzbezeichnung", "TBehaelter", "BNR=" + Format(TBNR)) + ", " -End If - -If Not IsNull(TBSNR) And TBSNR > 0 Then - Beschreibung = Beschreibung + " Behälterstandort = " + DFirst("Standort", "TBehaelterStandorte", "BSNR=" + Format(TBSNR)) + ", " -End If - -If Not IsNull(TSNR) And TSNR <> "" Then - Beschreibung = Beschreibung + " Sorte = " + DFirst("Bezeichnung", "TSorten", "SNR='" + Format(TSNR) + "'") + ", " -End If - -If Not IsNull(TSANR) And TSANR <> "" Then - Beschreibung = Beschreibung + " Sortenattribut = " + DFirst("Attribut", "TSortenattribute", "SaNR='" + Format(TSANR) + "'") + ", " -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 - diff --git a/wgmaster/vba/form/Form_MExport.frm b/wgmaster/vba/form/Form_MExport.frm deleted file mode 100644 index ad3dd9e..0000000 --- a/wgmaster/vba/form/Form_MExport.frm +++ /dev/null @@ -1,310 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - -If OMitglieder = True Or OLieferungen = True Then - - If Not IsNull(TZNR) And TZNR <> "" Then - - DoCmd.Hourglass True - ExportAll TExportFile, TZNR, TLesejahr - DoCmd.Hourglass False - - SetParameter "ExportPfad", TExportFile - DoCmd.Close - - Else - MsgBox ("Bitte wählen Sie eine Zweigstelle aus !") - End If - -Else - MsgBox ("Bitte wählen Sie zuerst aus, welche Daten Sie exportieren wollen !") -End If - -End Sub - - - -Sub ExportAll(filename As String, ZNR1 As Long, Lesejahr1 As Long) - - -Dim db1 As Database -Dim rs1 As Recordset -Dim db2 As Database -Dim rs2 As Recordset -Dim item1 -Dim i As Integer -Dim tempfilename1 As String -Dim filename1 As String -Dim query1 As String -Dim datapath As String - -datapath = GetDataPath - - -' Create new database - - - If Fileexists(filename) Then FileSystem.Kill (filename) - - Set db2 = Application.DBEngine.Workspaces(0).CreateDatabase(filename, dbLangGeneral) - db2.Close - - 'TLieferungen - - If OLieferungen = True Then - - filename1 = "TLieferungen" - tempfilename1 = "xTLieferungen" - query1 = "SELECT * FROM TLieferungen WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) - - Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db1 = CurrentDb - - DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True - DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True - DoCmd.DeleteObject acTable, tempfilename1 - - Set rs2 = db2.OpenRecordset(tempfilename1) - Set rs1 = db1.OpenRecordset(query1) - - While Not rs1.EOF - rs2.AddNew - For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2.Update - rs1.MoveNext - Wend - - - Dim lieferungen As Integer - - lieferungen = rs1.recordcount - - rs1.Close - rs2.Close - db1.Close - db2.Close - - - - - 'TLieferungAbschlag - filename1 = "TLieferungAbschlag" - tempfilename1 = "xTLieferungAbschlag" - query1 = "SELECT TLieferungAbschlag.* FROM TLieferungAbschlag INNER JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) - - Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db1 = CurrentDb - - DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True - DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True - DoCmd.DeleteObject acTable, tempfilename1 - - Set rs2 = db2.OpenRecordset(tempfilename1) - Set rs1 = db1.OpenRecordset(query1) - - While Not rs1.EOF - rs2.AddNew - For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2.Update - rs1.MoveNext - Wend - 'MsgBox (Format(rs1.RecordCount) + " Lieferungs-Abschläge exportiert") - rs1.Close - rs2.Close - db1.Close - db2.Close - - - MsgBox (Format(lieferungen) + " Lieferungen exportiert") - - End If - - - 'TMitglieder - - If OMitglieder = True Then - - filename1 = "TMitglieder" - tempfilename1 = "xTMitglieder" - query1 = "SELECT * FROM TMitglieder WHERE ZNR=" + Format(ZNR1) - - Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db1 = CurrentDb - - DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True - DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True - DoCmd.DeleteObject acTable, tempfilename1 - - Set rs2 = db2.OpenRecordset(tempfilename1) - Set rs1 = db1.OpenRecordset(query1) - - While Not rs1.EOF - rs2.AddNew - For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2.Update - rs1.MoveNext - Wend - MsgBox (Format(rs1.recordcount) + " Mitglieder exportiert") - rs1.Close - rs2.Close - db1.Close - db2.Close - - 'TFlaechenbindungen - filename1 = "TFlaechenbindungen" - tempfilename1 = "xTFlaechenbindungen" - query1 = "SELECT TFlaechenbindungen.* FROM TMitglieder INNER JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR WHERE ZNR = " + Format(ZNR1) - - Set db2 = DBEngine.Workspaces(0).OpenDatabase(filename) - Set db1 = CurrentDb - - DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True - DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True - DoCmd.DeleteObject acTable, tempfilename1 - - Set rs2 = db2.OpenRecordset(tempfilename1) - Set rs1 = db1.OpenRecordset(query1) - - While Not rs1.EOF - rs2.AddNew - For item1 = 0 To (db2.TableDefs(tempfilename1).Fields.Count - 1) - rs2(item1) = rs1(item1) - Next item1 - - rs2.Update - rs1.MoveNext - Wend - MsgBox (Format(rs1.recordcount) + " Flächenbindungen exportiert") - rs1.Close - rs2.Close - db1.Close - db2.Close -End If - -'TChargen -If OChargen = True Then - - filename1 = "TChargen" - tempfilename1 = "xTChargen" - query1 = "SELECT * FROM TChargen WHERE ZNR=" + Format(ZNR1) + " AND Jahrgang=" + Format(Lesejahr1) - - Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db1 = CurrentDb - - DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True - DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True - DoCmd.DeleteObject acTable, tempfilename1 - - Set rs2 = db2.OpenRecordset(tempfilename1) - Set rs1 = db1.OpenRecordset(query1) - - While Not rs1.EOF - rs2.AddNew - For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2.Update - rs1.MoveNext - Wend - - MsgBox (Format(rs1.recordcount) + " Chargen exportiert") - - rs1.Close - rs2.Close - db1.Close - db2.Close - - End If - - - - - -Exit Sub - -WhatIsLos: - MsgBox ("Error") - - -End Sub - - - - - - -Private Sub Form_Open(Cancel As Integer) - -TZNR = DFirst("ZNR", "TZweigstellen") -If Month(Date) < 9 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If -OListe = 1 - -Dim filename - -filename = GetParameter("ExportPfad") - -If Len(filename) > 0 Then - TExportFile = filename -End If - - -End Sub - - -Private Sub OChargen_Click() - -If OLieferungen = True Or OChargen = True Then - TLesejahr.Visible = True - XLesejahr.Visible = True -Else - TLesejahr.Visible = False - XLesejahr.Visible = False -End If - -End Sub - -Private Sub OLieferungen_Click() - -If OLieferungen = True Or OChargen = True Then - TLesejahr.Visible = True - XLesejahr.Visible = True -Else - TLesejahr.Visible = False - XLesejahr.Visible = False -End If - -End Sub - -Function Fileexists(filename As String) As Boolean - -On Error GoTo NoFile - -If FileSystem.GetAttr(filename) >= 0 Then - Fileexists = True -Else - Fileexists = False -End If - -Exit Function - -NoFile: - Fileexists = False - Exit Function - -End Function \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MExportAuszahlung.frm b/wgmaster/vba/form/Form_MExportAuszahlung.frm deleted file mode 100644 index 0cd3e3b..0000000 --- a/wgmaster/vba/form/Form_MExportAuszahlung.frm +++ /dev/null @@ -1,1370 +0,0 @@ - -'Globals for data exchange with export functions - -Dim mgnr1 As String -Dim nachname1 As String -Dim vorname1 As String -Dim strasse1 As String -Dim plz1 As String -Dim ort1 As String - -Dim bhkontonr1 As String -Dim blz1 As String -Dim bankname1 As String -Dim bankname2 As String -Dim kontonr1 As String -Dim IBAN As String -Dim BIC As String - -Dim netto1 As Double -Dim mwst1 As Double -Dim mwstprozent1 As Double -Dim brutto1 As Double - -Dim sum_netto1 As Double -Dim sum_mwst1 As Double -Dim sum_brutto1 As Double - -Dim noIBANorBIC As String - -'Globals for bmd export - -Dim Buchungsdatum1 As Date -Dim Gegenkonto1 As String -Dim Belegnummer1 As String -Dim Belegdatum1 As Date -Dim Kostenstelle1 As String -Dim Steuercode1 As String -Dim Buchungscode1 As String -Dim Zahlungsziel1 As String -Dim Skonto1 As String -Dim Skonto2 As String -Dim Vertreter1 As String -Dim Provision1 As String -Dim Benutzernummer1 As String -Dim Belegsymbol1 As String - -Dim BruttoKonto As String -Dim NettoKonto As String -Dim MwStKonto As String - - -Private Sub BOk_Click() - -If Fileexists(TExportDatei) Then - If MsgBox("Datei " + TExportDatei + " existiert bereits ! Überschreiben", vbYesNo) = vbYes Then - ExportAuszahlung TExportDatei, LAuszahlungsAnteil - 'DoCmd.Close - End If -Else - If Not IsNull(TExportDatei) And TExportDatei <> "" Then - ExportAuszahlung TExportDatei, LAuszahlungsAnteil - 'DoCmd.Close - Else - MsgBox "Bitte geben Sie eine Exportdatei an !", vbCritical - End If -End If - -End Sub - - -Private Sub Form_Close() - -If Not IsNull(TExportDatei) And TExportDatei <> "" Then - Select Case OExportOption - Case 1: ' CDF - SetParameter "AUSZAHLUNGEXPORTDATEI1", TExportDatei - Case 2: ' BMD: PERSONENKONTEN - SetParameter "AUSZAHLUNGEXPORTDATEI2", TExportDatei - Case 3: ' BMD: SACHKONTEN - SetParameter "AUSZAHLUNGEXPORTDATEI3", TExportDatei - Case 4: ' DBF - SetParameter "AUSZAHLUNGEXPORTDATEI4", TExportDatei - Case 5: ' DBF - SetParameter "AUSZAHLUNGEXPORTDATEI5", TExportDatei - End Select - -End If - -SetParameter "AUSZAHLUNGEXPORTDEFAULT", OExportOption - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -If IsNull(GetParameter("AUSZAHLUNGEXPORTDEFAULT")) Then - SetParameter "AUSZAHLUNGEXPORTDEFAULT", 1 -End If - -OExportOption = GetParameter("AUSZAHLUNGEXPORTDEFAULT") - -Select Case OExportOption - -Case 1: 'CDF - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI1")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI1", "C:\AUSZAHLUNG.TXT" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI1") -Case 2: 'BMD PERSONENKONTO - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI2")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI2", "C:\PEKO.BMD" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI2") -Case 3: 'BMD SACHKONTO - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI3")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI3", "C:\SAKO.BMD" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI3") - -Case 4: 'DBF - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI4")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI4", "C:\AUSZAHLG.DBF" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI4") - -Case 5: 'ELBA - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI5")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI5", "C:\AUSZAHLG.ELBA" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI5") - -End Select - -LAuszahlungsAnteil = 0 - - -End Sub - - - - - -Sub ExportAuszahlung(filename1 As String, AuszahlungsAnteilModus As Long) - - -Dim db1 As Database -Dim rs_auszahlung As Recordset -Dim query1 As String -Dim Lesejahr1 As Long -Dim rcounter As Long -Dim line1 As String -Dim filenum - - - -DoCmd.Hourglass True - -Lesejahr1 = Forms!FAuszahlung!TLesejahr -query1 = "SELECT Nachname, Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.MGNR, BHKontonummer, TMitglieder.IBAN, TMitglieder.BIC, Sum(TLieferungen.BTeilzahlung1) AS SBTeilzahlung1, Sum(TLieferungen.BTeilzahlung2) AS SBTeilzahlung2, Sum(TLieferungen.BTeilzahlung3) AS SBTeilzahlung3, Sum(TLieferungen.BTeilzahlung4) AS SBTeilzahlung4, Sum(TLieferungen.BTeilzahlung5) AS SBTeilzahlung5, Sum(TLieferungen.BEndauszahlung) AS SBEndauszahlung, Name1, Name2, TMitglieder.BLZ as BLZ, KontoNr, Sum(TLieferungen.BProbeauszahlung) AS SBProbeauszahlung, TMitglieder.Buchführend FROM TBanken RIGHT JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ " -query1 = query1 + "GROUP BY TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.MGNR, BHKontonummer, Name1, Name2, TMitglieder.BLZ, TMitglieder.KontoNr, TMitglieder.IBAN, TMitglieder.BIC, TMitglieder.Buchführend, Year([Datum]) HAVING (((Year([Datum]))=" + Format(Lesejahr1) + "))" - -Set db1 = CurrentDb -Set rs_auszahlung = db1.OpenRecordset(query1) - -rcounter = 0 -sum_netto1 = 0 -sum_mwst1 = 0 -sum_brutto1 = 0 - -filenum = FreeFile - -Open filename1 For Output As filenum - - Select Case OExportOption - - Case 1: ' CDF - PrintAuszahlungCDFHeader (filenum) - Case 2: ' BMD - PrintAuszahlungBMDHeader (filenum) - Case 3: ' BMD SAKO - PrintAuszahlungBMDSakoHeader (filenum) - Case 4: ' DBF - ' the file access is not used - Close filenum - FileSystem.Kill (filename1) - PrintAuszahlungDBFHeader (filenum) - Open filename1 For Input As filenum - Case 5: ' CDF - PrintAuszahlungElbaHeader (filenum) - End Select - -noIBANorBIC = "" -While Not rs_auszahlung.EOF - - mgnr1 = Format(rs_auszahlung![MGNR]) - If IsNull(rs_auszahlung!Nachname) Then nachname1 = "" Else nachname1 = rs_auszahlung!Nachname - If IsNull(rs_auszahlung!Vorname) Then vorname1 = "" Else vorname1 = rs_auszahlung!Vorname - If IsNull(rs_auszahlung![Straße]) Then strasse1 = "" Else strasse1 = rs_auszahlung![Straße] - If IsNull(rs_auszahlung![PLZ]) Then plz1 = "" Else plz1 = rs_auszahlung!PLZ - If IsNull(rs_auszahlung!Ort) Then ort1 = "" Else ort1 = rs_auszahlung!Ort - 'If IsNull(rs_auszahlung!BLZ) Then blz1 = "" Else blz1 = rs_auszahlung!BLZ - 'If IsNull(rs_auszahlung!KontoNr) Then kontonr1 = "" Else kontonr1 = rs_auszahlung!KontoNr - If IsNull(rs_auszahlung!BIC) Then - BIC = "" - noIBANorBIC = noIBANorBIC + Format(rs_auszahlung!MGNR) + ", " - Else - BIC = rs_auszahlung!BIC - End If - If IsNull(rs_auszahlung!IBAN) Then - IBAN = "" - If Not IsNull(rs_auszahlung!BIC) Then - noIBANorBIC = noIBANorBIC + Format(rs_auszahlung!MGNR) + ", " - End If - Else - IBAN = rs_auszahlung!IBAN - End If - If IsNull(rs_auszahlung!BHKontonummer) Then bhkontonr1 = "" Else bhkontonr1 = rs_auszahlung!BHKontonummer - If IsNull(rs_auszahlung!Name1) Then bankname1 = "" Else bankname1 = rs_auszahlung!Name1 - If IsNull(rs_auszahlung!Name2) Then bankname2 = "" Else bankname2 = rs_auszahlung!Name2 - - ' calculate netto1 - - Select Case Forms!FAuszahlung!TZahlungNr - - Case 1: netto1 = rs_auszahlung!SBTeilzahlung1 - Case 2: netto1 = rs_auszahlung!SBTeilzahlung2 - Case 3: netto1 = rs_auszahlung!SBTeilzahlung3 - Case 4: netto1 = rs_auszahlung!SBTeilzahlung4 - Case 5: netto1 = rs_auszahlung!SBTeilzahlung5 - Case 6: netto1 = rs_auszahlung!SBEndauszahlung - rs_auszahlung!SBTeilzahlung5 - rs_auszahlung!SBTeilzahlung4 - rs_auszahlung!SBTeilzahlung3 - rs_auszahlung!SBTeilzahlung2 - rs_auszahlung!SBTeilzahlung1 - Case 7: netto1 = rs_auszahlung!SBProbeauszahlung - End Select - - 'Anteil % anwenden - Select Case AuszahlungsAnteilModus - Case 0: '100% - netto1 = Runden(netto1, 2) - Case 1: '50% Teilzahlung - netto1 = Runden(netto1 * 50 / 100, 2) - Case 2: '50% Restzahlung - netto1 = Runden(netto1, 2) - Runden(netto1 * 50 / 100, 2) - Case 3: '75% Teilzahlung - netto1 = Runden(netto1 * 75 / 100, 2) - Case 4: '25% Restzahlung - netto1 = Runden(netto1, 2) - Runden(netto1 * 75 / 100, 2) - - End Select - - 'calculate mwst1 - If rs_auszahlung![Buchführend] Then - mwstprozent1 = GetParameter("MWST2") - Else - mwstprozent1 = GetParameter("MWST1") - End If - mwst1 = Runden(netto1 * mwstprozent1 / 100, 2) - 'mwst1 = netto1 * mwstprozent1 / 100 - - 'calculate brutto1 - brutto1 = netto1 + mwst1 - - 'calculate sums - sum_brutto1 = sum_brutto1 + brutto1 - sum_netto1 = sum_netto1 + netto1 - sum_mwst1 = sum_mwst1 + mwst1 - - line1 = rs_auszahlung![MGNR] - - ' output to file - - Select Case OExportOption - - Case 1: ' CDF - PrintAuszahlungCDFData (filenum) - Case 2: ' BMD - PrintAuszahlungBMDData (filenum) - Case 3: ' BMD SAKO - PrintAuszahlungBMDSakoData (filenum) - Case 4: ' DBF - PrintAuszahlungDBFData (filenum) - Case 5: ' Elba - PrintAuszahlungElbaData (filenum) - End Select - - rs_auszahlung.MoveNext - rcounter = rcounter + 1 -Wend - -rs_auszahlung.Close - -DoCmd.Hourglass False - -MsgBox (Format(rcounter) + " Auszahlungen erfolgreich exportiert ! Summe Netto: " + Format(sum_netto1) + " Summe MwSt: " + Format(sum_mwst1) + " Summe Brutto: " + Format(sum_brutto1)) - -If noIBANorBIC <> "" Then - MsgBox ("Folgende Mitglieder (MGNR) haben fehlende IBAN/BIC Daten:" + Chr(13) + Chr(10) + noIBANorBIC) -End If - -Select Case OExportOption - - Case 1: ' CDF - PrintAuszahlungCDFFooter (filenum) - Case 2: ' BMD - PrintAuszahlungBMDFooter (filenum) - Case 3: ' BMD - PrintAuszahlungBMDSakoFooter (filenum) - Case 4: ' DBF - PrintAuszahlungDBFFooter (filenum) - Case 5: ' Elba - PrintAuszahlungElbaFooter (filenum) - -End Select - -Close filenum - -End Sub - -Private Sub OExportOption_Click() - -Select Case OExportOption - -Case 1: 'CDF - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI1")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI1", "C:\AUSZAHLUNG.TXT" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI1") -Case 2: 'BMD - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI2")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI2", "C:\PEKO.BMD" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI2") -Case 3: 'BMD SACHKONTO - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI3")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI3", "C:\SAKO.BMD" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI3") - -Case 4: 'DBF - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI4")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI4", "C:\AUSZAHLG.DBF" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI4") - -Case 5: 'ELBA - If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI5")) Then - SetParameter "AUSZAHLUNGEXPORTDATEI5", "C:\AUSZAHLG.ELBA" - End If - TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI5") - - -End Select - - -End Sub - - - - - -' ****************************************************************************** -' THE EXPORT ROUTINES -' ****************************************************************************** - - -' ****************************************************************************** -' CDF EXPORT -' ****************************************************************************** - - -Sub PrintAuszahlungCDFData(filenumber) - -Dim s1 As String -s1 = ";" - -Print #filenumber, mgnr1 + s1 + nachname1 + s1 + vorname1 + s1 + strasse1 + s1 + plz1 + s1 + ort1 + s1 + IBAN + s1 + BIC + s1 + bankname1 + s1 + bankname2 + s1 + bhkontonr1 + s1 + Format(netto1, "#,##0.00") + s1 + Format(mwstprozent1) + s1 + Format(mwst1, "#,##0.00") + s1 + Format(brutto1, "#,##0.00") - -End Sub - - -Sub PrintAuszahlungCDFHeader(filenumber) - -Dim line1 As String -Dim s1 As String -s1 = ";" -line1 = "" - -Print #filenumber, "AUSZAHLUNGSLISTE" -Print #filenumber, "für Lesejahr " + Format(Forms!FAuszahlung!TLesejahr) - -Select Case Forms!FAuszahlung!TZahlungNr - Case 1: Print #filenumber, "1. Teilzahlung" - Case 2: Print #filenumber, "2. Teilzahlung" - Case 3: Print #filenumber, "3. Teilzahlung" - Case 4: Print #filenumber, "4. Teilzahlung" - Case 5: - If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then - Print #filenumber, "" - Else - Print #filenumber, GetParameter("FREIERAUSZAHLUNGSTITEL") - End If - Case 6: Print #filenumber, "Endauszahlung" - Case 7: Print #filenumber, "Probeauszahlung" -End Select - -Print #filenumber, Forms!FAuszahlung!TTitel -Print #filenumber, "" -Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "IBAN" + s1 + "BIC" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "BHKONTONUMMER" + s1 + "NETTO" + s1 + "MWST PROZENT " + s1 + "MWST" + s1 + "BRUTTO" - -End Sub - -Sub PrintAuszahlungCDFFooter(filenumber) - - -End Sub - - - - -' ****************************************************************************** -' BMD EXPORT: PERSONENKONTEN -' ****************************************************************************** - - -Sub PrintAuszahlungBMDData(filenumber) - -Dim line1 As String -Dim str1 As String - -line1 = "" -str1 = "" - -'bhkontonr -str1 = FillUp(bhkontonr1, 6, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'buchungsdatum -str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00") -line1 = line1 + str1 -'MsgBox (str1) - -'gegenkonto -str1 = FillUp(Gegenkonto1, 6, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'belegnummer -str1 = FillUp(Belegnummer1, 6, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'belegdatum -str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00") -line1 = line1 + str1 -'MsgBox (str1) - -'kostenstelle -str1 = FillUp(Kostenstelle1, 6, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'mwstprozent -str1 = Format(mwstprozent1, "00") -line1 = line1 + str1 -'MsgBox (str1) - -'steuercode -str1 = FillUp(Steuercode1, 1, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'buchungscode -str1 = FillUp(Buchungscode1, 1, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'buchungsbetrag -str1 = Format(brutto1 * 100, "00000000000") -If Buchungscode1 = "1" Then - str1 = str1 + "+" -Else - str1 = str1 + "-" -End If -line1 = line1 + str1 -'MsgBox (str1) - -'steuerbetrag -'str1 = Format(mwst1 * 100, "00000000000") -'If Buchungscode1 = "1" Then -' str1 = str1 + "+" -'Else -' str1 = str1 + "-" -'End If -str1 = "00000000000-" -line1 = line1 + str1 -'MsgBox (str1) - -'buchungstext -Select Case Forms!FAuszahlung!TZahlungNr - Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr) - Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr) -End Select -'str1 = FillUp(nachname1 + " " + vorname1, 12, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'zahlungsziel -str1 = FillUp(Zahlungsziel1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'skonto % -str1 = FillUp(Skonto1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'skonto tage -str1 = FillUp(Skonto2, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'Vertreter Nr -str1 = FillUp(Vertreter1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'provision -str1 = FillUp(Provision1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'benutzernummer -str1 = FillUp(Benutzernummer1, 1, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'Belegsymbol -str1 = FillUp(Belegsymbol1, 2, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'platzhalter " " -str1 = " " -line1 = line1 + str1 -'MsgBox (str1) - -'sperrcode -str1 = "0" -line1 = line1 + str1 -'MsgBox (str1) - -'stern -str1 = "*" -line1 = line1 + str1 -'MsgBox (str1) - -Print #filenumber, line1 - -End Sub - - - -Sub PrintAuszahlungBMDHeader(filenumber) - -Dim zahlungszieldatum As Date -Dim zahlungszieltage As Integer - -'DoCmd.OpenForm -Do - Buchungsdatum1 = InputBox("Buchungsdatum: ", , Format(Date, "dd.mm.yyyy")) - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE" - End If -Loop While IsNull(Buchungsdatum1) - -Do - Belegdatum1 = InputBox("Belegdatum: ", , Format(Buchungsdatum1, "dd.mm.yyyy")) - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE" - End If -Loop While IsNull(Belegdatum1) - -Do - zahlungszieldatum = InputBox("Zahlungsziel: ", , Format(Buchungsdatum1, "dd.mm.yyyy")) - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE" - End If -Loop While IsNull(zahlungszieldatum) - -zahlungszieltage = zahlungszieldatum - Buchungsdatum1 -Zahlungsziel1 = Format(zahlungszieltage) - -Kostenstelle1 = "000000" -Gegenkonto1 = "000000" -Belegnummer1 = "000000" -Steuercode1 = "0" -Buchungscode1 = "2" -Skonto1 = "000" -Skonto2 = "000" -Vertreter1 = "001" -Provision1 = "000" -Benutzernummer1 = "1" -Belegsymbol1 = "AG" - -DoCmd.Hourglass True - -End Sub - - -Sub PrintAuszahlungBMDFooter(filenumber) - -If MsgBox("Wollen Sie auch die Mitgliederstammdaten exportieren ?", vbYesNo) = vbYes Then - - DoCmd.OpenForm "MExportMitglieder" - -End If - -End Sub - - - -' ****************************************************************************** -' BMD EXPORT: SACHKONTEN -' ****************************************************************************** - - -Sub PrintAuszahlungBMDSakoData(filenumber) - - -End Sub - - - -Sub PrintAuszahlungBMDSakoHeader(filenumber) - -Dim zahlungszieldatum As Date -Dim zahlungszieltage As Integer - -'DoCmd.OpenForm - -Do - BruttoKonto = InputBox("Sachkonto Brutto: ", , "003310") - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !" - End If -Loop While IsNull(BruttoKonto) - -Do - NettoKonto = InputBox("Sachkonto Netto: ", , "005100") - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !" - End If -Loop While IsNull(NettoKonto) - -Do - MwStKonto = InputBox("Sachkonto MwSt: ", , "002510") - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !" - End If -Loop While IsNull(MwStKonto) - -Do - Buchungsdatum1 = InputBox("Buchungsdatum: ", , Format(Date, "dd.mm.yyyy")) - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE" - End If -Loop While IsNull(Buchungsdatum1) - -Do - Belegdatum1 = InputBox("Belegdatum: ", , Format(Buchungsdatum1, "dd.mm.yyyy")) - If IsNull(Buchungsdatum1) Then - MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE" - End If -Loop While IsNull(Belegdatum1) - -Kostenstelle1 = "000000" -Gegenkonto1 = "000000" -Belegnummer1 = "000000" -Steuercode1 = "0" -Benutzernummer1 = "1" -Belegsymbol1 = " " -mwstprozent1 = 0 -DoCmd.Hourglass True - -End Sub - - -Sub PrintAuszahlungBMDSakoFooter(filenumber) - -Dim line1 As String -Dim str1 As String - - -' 1. Bruttobuchung -' ================ - -line1 = "" -str1 = "" -mwstprozent1 = 0 - -'bhkontonr -str1 = FillUp(BruttoKonto, 6, 1, "0") -line1 = line1 + str1 - -'buchungsdatum -str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00") -line1 = line1 + str1 - -'gegenkonto -str1 = FillUp(Gegenkonto1, 6, 1, "0") -line1 = line1 + str1 - -'belegnummer -str1 = FillUp(Belegnummer1, 6, 1, "0") -line1 = line1 + str1 - -'belegdatum -str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00") -line1 = line1 + str1 - -'kostenstelle -str1 = FillUp(Kostenstelle1, 6, 1, "0") -line1 = line1 + str1 - -'mwstprozent -str1 = Format(mwstprozent1, "00") -line1 = line1 + str1 - -'steuercode -str1 = FillUp(Steuercode1, 1, 1, "0") -line1 = line1 + str1 - -'buchungscode -Buchungscode1 = "2" -str1 = FillUp(Buchungscode1, 1, 1, "0") -line1 = line1 + str1 - -'buchungsbetrag -str1 = Format(sum_brutto1 * 100, "00000000000") -str1 = str1 + "-" -line1 = line1 + str1 - -'steuerbetrag -str1 = "00000000000-" -line1 = line1 + str1 - -'buchungstext -Select Case Forms!FAuszahlung!TZahlungNr - Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr) - Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr) -End Select -str1 = FillUp(str1, 18, 0, " ") -line1 = line1 + str1 - -'platzhalter: 0 -str1 = "0" -line1 = line1 + str1 - -'buchungsmonat: 00 -str1 = "00" -line1 = line1 + str1 - -'platzhalter: 000000 -str1 = "000000" -line1 = line1 + str1 - -'benutzernummer -str1 = FillUp(Benutzernummer1, 1, 1, "0") -line1 = line1 + str1 - -'Belegsymbol -str1 = FillUp(Belegsymbol1, 2, 1, "0") -line1 = line1 + str1 - -'platzhalter " " -str1 = " " -line1 = line1 + str1 - -'sperrcode -str1 = "0" -line1 = line1 + str1 - -'stern -str1 = "*" -line1 = line1 + str1 - -Print #filenumber, line1 - - - -' 2. Nettobuchung -' ================ - -line1 = "" -str1 = "" - -'bhkontonr -str1 = FillUp(NettoKonto, 6, 1, "0") -line1 = line1 + str1 - -'buchungsdatum -str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00") -line1 = line1 + str1 - -'gegenkonto -str1 = FillUp(Gegenkonto1, 6, 1, "0") -line1 = line1 + str1 - -'belegnummer -str1 = FillUp(Belegnummer1, 6, 1, "0") -line1 = line1 + str1 - -'belegdatum -str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00") -line1 = line1 + str1 - -'kostenstelle -str1 = FillUp(Kostenstelle1, 6, 1, "0") -line1 = line1 + str1 - -'mwstprozent -str1 = Format(mwstprozent1, "00") -line1 = line1 + str1 - -'steuercode -str1 = FillUp(Steuercode1, 1, 1, "0") -line1 = line1 + str1 - -'buchungscode -Buchungscode1 = "1" -str1 = FillUp(Buchungscode1, 1, 1, "0") -line1 = line1 + str1 - -'buchungsbetrag -str1 = Format(sum_netto1 * 100, "00000000000") -str1 = str1 + "+" -line1 = line1 + str1 - -'steuerbetrag -str1 = "00000000000+" -line1 = line1 + str1 - -'buchungstext -Select Case Forms!FAuszahlung!TZahlungNr - Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr) - Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr) -End Select -str1 = FillUp(str1, 18, 0, " ") -line1 = line1 + str1 - -'platzhalter: 0 -str1 = "0" -line1 = line1 + str1 - -'buchungsmonat: 00 -str1 = "00" -line1 = line1 + str1 - -'platzhalter: 000000 -str1 = "000000" -line1 = line1 + str1 - -'benutzernummer -str1 = FillUp(Benutzernummer1, 1, 1, "0") -line1 = line1 + str1 - -'Belegsymbol -str1 = FillUp(Belegsymbol1, 2, 1, "0") -line1 = line1 + str1 - -'platzhalter " " -str1 = " " -line1 = line1 + str1 - -'sperrcode -str1 = "0" -line1 = line1 + str1 - -'stern -str1 = "*" -line1 = line1 + str1 - -Print #filenumber, line1 - - - - -' 3. MwStbuchung -' ================ - -line1 = "" -str1 = "" - -'bhkontonr -str1 = FillUp(MwStKonto, 6, 1, "0") -line1 = line1 + str1 - -'buchungsdatum -str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00") -line1 = line1 + str1 - -'gegenkonto -str1 = FillUp(Gegenkonto1, 6, 1, "0") -line1 = line1 + str1 - -'belegnummer -str1 = FillUp(Belegnummer1, 6, 1, "0") -line1 = line1 + str1 - -'belegdatum -str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00") -line1 = line1 + str1 - -'kostenstelle -str1 = FillUp(Kostenstelle1, 6, 1, "0") -line1 = line1 + str1 - -'mwstprozent -str1 = Format(mwstprozent1, "00") -line1 = line1 + str1 - -'steuercode -str1 = FillUp(Steuercode1, 1, 1, "0") -line1 = line1 + str1 - -'buchungscode -Buchungscode1 = "1" -str1 = FillUp(Buchungscode1, 1, 1, "0") -line1 = line1 + str1 - -'buchungsbetrag -str1 = Format(sum_mwst1 * 100, "00000000000") -str1 = str1 + "+" -line1 = line1 + str1 - -'steuerbetrag -str1 = "00000000000+" -line1 = line1 + str1 - -'buchungstext -Select Case Forms!FAuszahlung!TZahlungNr - Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr) - Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr) - Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr) -End Select -str1 = FillUp(str1, 18, 0, " ") -line1 = line1 + str1 - -'platzhalter: 0 -str1 = "0" -line1 = line1 + str1 - -'buchungsmonat: 00 -str1 = "00" -line1 = line1 + str1 - -'platzhalter: 000000 -str1 = "000000" -line1 = line1 + str1 - -'benutzernummer -str1 = FillUp(Benutzernummer1, 1, 1, "0") -line1 = line1 + str1 - -'Belegsymbol -str1 = FillUp(Belegsymbol1, 2, 1, "0") -line1 = line1 + str1 - -'platzhalter " " -str1 = " " -line1 = line1 + str1 - -'sperrcode -str1 = "0" -line1 = line1 + str1 - -'stern -str1 = "*" -line1 = line1 + str1 - -Print #filenumber, line1 - - - - -End Sub - - - - - - - - - -' ****************************************************************************** -' DBF EXPORT -' ****************************************************************************** - -Sub PrintAuszahlungDBFData(filenumber) - -' Do nothing - -End Sub - - -Sub PrintAuszahlungDBFHeader(filenumber) - -Dim SEL1 As String -Dim GROUP1 As String -Dim where1 As String -Dim order1 As String -Dim query1 -Dim savepath1 -Dim temptablename1 - -SEL1 = "SELECT DISTINCT TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße as STRASSE, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1 AS Bank, TMitglieder.BHKontonummer AS BHKONTO, CCur(Sum(IIf([Formulare]![FAuszahlung]![TZahlungNr]=1,[BTeilzahlung1],IIf([Formulare]![FAuszahlung]![TZahlungNr]=2,[BTeilzahlung2],IIf([Formulare]![FAuszahlung]![TZahlungNr]=3,[BTeilzahlung3],IIf([Formulare]![FAuszahlung]![TZahlungNr]=4,[BTeilzahlung4],IIf([Formulare]![FAuszahlung]![TZahlungNr]=5,[BTeilzahlung5],IIf([Formulare]![FAuszahlung]![TZahlungNr]=6,[BEndauszahlung]-[BTeilzahlung4]-[BTeilzahlung3]-[BTeilzahlung2]-[BTeilzahlung1],[BProbeauszahlung])))))))) AS NETTO, First(IIf([Buchführend],Getparameter('MWST2'),GetPArameter('MWST1'))) AS MWSTPROZ, Runden(NETTO*MWSTPROZ/100,2) as MWST, Runden(NETTO*(MWSTPROZ+100)/100,2) as BRUTTO" -SEL1 = SEL1 + " FROM TBanken RIGHT JOIN (TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ " -GROUP1 = " GROUP BY TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1, TMitglieder.BHKontonummer " - -Select Case OSortierung - -Case 1: order1 = " ORDER BY TMitglieder.MGNR " - -Case 2: order1 = " ORDER BY TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.Nachname, TMitglieder.Vorname " - -End Select - -where1 = " WHERE Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr) + " AND Storniert=false " - - -If Not IsNull(Forms!FAuszahlung!TZNR) And Forms!FAuszahlung!TZNR <> "" Then - where1 = where1 + " AND TLieferungen.ZNR=" + Format(Forms!FAuszahlung!TZNR) -End If - -If Not IsNull(Forms!FAuszahlung!TVon) And Forms!FAuszahlung!TVon >= 0 Then - - If OSortierung = 1 Then - where1 = where1 + " AND TLieferungen.MGNR>=" + Format(Forms!FAuszahlung!TVon) + " " - Else - where1 = where1 + " AND TMitglieder.PLZ>=" + Format(Forms!FAuszahlung!TVon) + " " - End If - -End If - -If Not IsNull(Forms!FAuszahlung!TBis) And Forms!FAuszahlung!TBis >= 0 Then - - If OSortierung = 1 Then - where1 = where1 + " AND TLieferungen.MGNR<=" + Format(Forms!FAuszahlung!TBis) + " " - Else - where1 = where1 + " AND TMitglieder.PLZ<=" + Format(Forms!FAuszahlung!TBis) + " " - End If - - - -End If - - -query1 = SEL1 + where1 + GROUP1 + order1 - -'savepath1 = InputBox("Excel Datei speichern unter:", "EXCEL DATEI EXPORTIEREN", "C:\Eigene Dateien\auszahlung.xls") -'If IsNull(savepath) Or savepath1 = "" Then -' Exit Sub -'End If - -DoCmd.Hourglass True - -queryname1 = "AAuszahlungExport" -temptablename1 = "xTempAuszahlungExport" -Dim db1 As Database -Set db1 = CurrentDb - -'On Error Resume Next -If QueryExists(queryname1) = True Then - DoCmd.DeleteObject acQuery, queryname1 -End If -db1.CreateQueryDef queryname1, query1 -db1.Close - -'DoCmd.TransferSpreadsheet acExport, 0, queryname1, TExportDatei, True -DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acQuery, queryname1, GetFilenameFromFullName(TExportDatei) - -'use table instead of query - -Dim rs1 As Recordset - -Set db1 = CurrentDb -If TableExists(temptablename1) Then - db1.Execute ("DROP TABLE " + temptablename1) -End If -'db1.Execute ("CREATE TABLE xTempAuszahlungExport (MGNR LONG, Nachname TEXT, Vorname TEXT, STRASSE TEXT, PLZ TEXT, Ort TEXT, KontoNr TEXT,BLZ TEXT, Bank TEXT, BHKONTO TEXT, NETTO DOUBLE, MWSTPROZ DOUBLE, MWST DOUBLE, BRUTTO DOUBLE);") - - -'reimport file for AnteilAuszahlung -DoCmd.TransferDatabase acImport, "DBASE IV", GetPathFromFullName(TExportDatei), acTable, GetFilenameFromFullName(TExportDatei), temptablename1 - -Set rs1 = db1.OpenRecordset(temptablename1) -While Not rs1.EOF - rs1.Edit - - 'Anteil % anwenden - Select Case LAuszahlungsAnteil - Case 0: '100% - 'rs1!Netto keeps unchanged - Case 1: '50% Teilzahlung - rs1!Netto = Runden(rs1!Netto * 50 / 100, 2) - Case 2: '50% Restzahlung - rs1!Netto = rs1!Netto - Runden(rs1!Netto * 50 / 100, 2) - - End Select - - rs1!mwst = Runden(rs1!Netto * rs1!mwstproz / 100, 2) - rs1!Brutto = Runden(rs1!Netto * (100 + rs1!mwstproz) / 100, 2) - - rs1.Update - rs1.MoveNext - -Wend -rs1.Close - -'DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acTable, temptablename1, GetFilenameFromFullName(TExportDatei) - -If QueryExists(queryname1) = True Then - DoCmd.DeleteObject acQuery, queryname1 -End If -db1.CreateQueryDef queryname1, "SELECT * FROM " + temptablename1 + " ORDER BY MGNR" -DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acQuery, queryname1, GetFilenameFromFullName(TExportDatei) - - - - -End Sub - - -Sub PrintAuszahlungDBFFooter(filenumber) - -' Do nothing - -End Sub - - - - - - -' ****************************************************************************** -' ELBA EXPORT -' ****************************************************************************** - - -Sub PrintAuszahlungElbaData(filenumber) - -Dim s1 As String -s1 = Chr(9) - -'CP 04.07.2007: Nur Werte >0 exportieren -If brutto1 > 0 Then - Print #filenumber, Format(brutto1, "0.00") + s1 + BIC + s1 + IBAN + s1 + nachname1 + " " + vorname1 + s1 + plz1 + " " + ort1 -End If - -End Sub - - -Sub PrintAuszahlungElbaHeader(filenumber) - -Dim line1 As String -Dim s1 As String -s1 = Chr(9) -line1 = "" - -'Print #filenumber, "AUSZAHLUNGSLISTE" -'Print #filenumber, "für Lesejahr " + Format(Forms!FAuszahlung!TLesejahr) - -'Select Case Forms!FAuszahlung!TZahlungNr -' Case 1: Print #filenumber, "1. Teilzahlung" -' Case 2: Print #filenumber, "2. Teilzahlung" -' Case 3: Print #filenumber, "3. Teilzahlung" -' Case 4: Print #filenumber, "4. Teilzahlung" -' Case 5: -' If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then -' Print #filenumber, "" -' Else -' Print #filenumber, GetParameter("FREIERAUSZAHLUNGSTITEL") -' End If -' Case 6: Print #filenumber, "Endauszahlung" -' Case 7: Print #filenumber, "Probeauszahlung" -'End Select - -'Print #filenumber, Forms!FAuszahlung!TTitel -'Print #filenumber, "" -'Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "KONTONUMMER" + s1 + "BLZ" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "BHKONTONUMMER" + s1 + "NETTO" + s1 + "MWST PROZENT " + s1 + "MWST" + s1 + "BRUTTO" - -End Sub - -Sub PrintAuszahlungElbaFooter(filenumber) - - -End Sub - - - -' ****************************************************************************** -' MISC FUNCTIONS -' ****************************************************************************** - - -Function QueryExists(query1) As Boolean - -Dim db1 As Database -Set db1 = CurrentDb -Dim x As QueryDef - -For Each x In db1.QueryDefs - If x.Name = query1 Then - 'MsgBox (X.Name) - QueryExists = True - Exit Function - End If -Next x - - QueryExists = False - -End Function - - -Function TableExists(table1) As Boolean - -Dim db1 As Database -Set db1 = CurrentDb -Dim x As TableDef - -For Each x In db1.TableDefs - If x.Name = table1 Then - TableExists = True - Exit Function - End If -Next x - - TableExists = False - -End Function - - - -Function GetPathFromFullName(fullname As String) As String - -Dim i -Dim path1 - -i = Len(fullname) - -While i > 1 And Mid(fullname, i, 1) <> "\" - i = i - 1 -Wend - -If i = 1 Then - path1 = "C:\" -Else - path1 = Left(fullname, i - 1) -End If -'MsgBox (path1) -If InStr(path1, "\") = 0 Then - path1 = path1 + "\" -End If - - -GetPathFromFullName = path1 - -End Function - - -Function GetFilenameFromFullName(fullname As String) As String - -Dim i -Dim filename1 - -i = Len(fullname) - -While i > 1 And Mid(fullname, i, 1) <> "\" - i = i - 1 -Wend - -If i > 1 Then i = i + 1 - -filename1 = Mid(fullname, i) -'MsgBox (filename1) -GetFilenameFromFullName = filename1 - -End Function - - -Function FillUp(text1 As String, laenge1 As Long, left1 As Long, fillchar1 As String) As String - -Dim str1 As String - -str1 = text1 - -If Len(str1) > laenge1 Then -' it is too long - str1 = Left(str1, laenge1) -End If - -While (Len(str1) < laenge1) - ' it is still too short - If left1 Then - str1 = fillchar1 + str1 - Else - str1 = str1 + fillchar1 - End If -Wend - - -FillUp = str1 - -End Function - - - -Function Fileexists(filename As String) As Boolean - -On Error GoTo NoFile - -If FileSystem.GetAttr(filename) >= 0 Then - Fileexists = True -Else - Fileexists = False -End If - -Exit Function - -NoFile: - Fileexists = False - Exit Function - -End Function - - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function diff --git a/wgmaster/vba/form/Form_MExportBKIListe.frm b/wgmaster/vba/form/Form_MExportBKIListe.frm deleted file mode 100644 index e6a3731..0000000 --- a/wgmaster/vba/form/Form_MExportBKIListe.frm +++ /dev/null @@ -1,380 +0,0 @@ - - -Private Sub BOk_Click() - -If Fileexists(TExportDatei) Then - If MsgBox("Datei " + TExportDatei + " existiert bereits ! Überschreiben", vbYesNo) = vbYes Then - ExportBKI TExportDatei, TLesejahr - 'DoCmd.Close - End If -Else - -If Not IsNull(TExportDatei) And TExportDatei <> "" Then - ExportBKI TExportDatei, TLesejahr - Else - MsgBox "Bitte geben Sie eine Exportdatei an !", vbCritical - End If -End If - -End Sub - - -Private Sub Form_Close() - -If Not IsNull(TExportDatei) And TExportDatei <> "" Then - SetParameter "BKIEXPORTDATEI", TExportDatei -End If - -End Sub - -Private Sub Form_Open(Cancel As Integer) - - -If IsNull(GetParameter("BKIEXPORTDATEI")) Then - SetParameter "BKIEXPORTDATEI", "C:\BKILISTE.TXT" -End If - -TExportDatei = GetParameter("BKIEXPORTDATEI") - -If Month(Date) < 9 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If - -End Sub - - - -Sub ExportBKI(filename1 As String, Lesejahr1 As Long) - - -Dim db1 As Database -Dim rs1 As Recordset -Dim line1 As String -Dim filenum -Dim query1 As String -Dim where1 As String -Dim order1 As String - -Dim wg_betriebsnummer As String -Dim wg_name As String -Dim wg_vorname As String -Dim wg_strasse As String -Dim wg_hausnr As String -Dim wg_plz As String -Dim wg_ort As String -Dim mg_betriebsnummer As String -Dim mg_name As String -Dim mg_vorname As String -Dim mg_strasse As String -Dim mg_hausnr As String -Dim mg_plz As String -Dim mg_ort As String -Dim li_datum As String -Dim li_menge As String -Dim li_art As String -Dim li_weiss As String -Dim li_rot As String -Dim li_sorte1 As String -Dim li_sorte2 As String -Dim li_sorte3 As String -Dim li_qualitaetsstufe As String -Dim li_jahrgang As String -Dim li_herkunft As String -Dim li_kwm As String -Dim li_oechsle As String -Dim mg_vollablieferer As String -Dim mg_hagesamt As String -Dim mg_haertrag As String -Dim mg_flaechenbindung As String -Dim rcount As Long -Dim gcount As Double - -Set db1 = CurrentDb -DoCmd.Hourglass True - -'WG-Betriebsnummer -'WG-Name -'WG-Vorname -'WG-Straße -'WG-Hausnr -'WG-Plz -'WG-Ort -'MG-Betriebsnummer -'MG-Name -'MG-Vorname -'MG-Straße -'MG-Hausnr -'MG-Plz -'MG-Ort -'Lieferung-Datum -'Lieferung-Menge in kg -'Lieferung-Art='TB' -'Lieferung-Weiß='J' oder leer -'Lieferung-Rot='J' oder leer -'Lieferung-Sorte1 -'Lieferung-Sorte2 -'Lieferung-Sorte3 -'Lieferung-Qualitätsstufe -'Lieferung-Jahrgang -'Lieferung-Herkunft -'Lieferung-KMW -'Lieferung-Oe -'Vollablieferer -'Ha gesamt -'Ha ertragsfähig -'Flächenbindung in Ha - -rcount = 0 -gcount = 0 -wg_betriebsnummer = GetParameter("MANDANTENBETRIEBSNUMMER") -wg_name = GetParameter("MANDANTENNAME1") -wg_vorname = GetParameter("MANDANTENNAME2") -ExtractFromStrasse GetParameter("MANDANTENSTRASSE"), wg_strasse, wg_hausnr -wg_plz = GetParameter("MANDANTENPLZ") -wg_ort = GetParameter("MANDANTENORT") - -query1 = "SELECT TMitglieder.MGNR, TMitglieder.Betriebsnummer, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TLieferungen.Datum, TLieferungen.Gewicht, TSorten.Typ, TSorten.Bezeichnung, TQualitaetsstufen.BKIKuerzel, TLieferungen.SNR, TRegionen.BKIKuerzel, TGebiete.BKIKuerzel, TUmrechnung.KW, TLieferungen.Oechsle,TLieferungen.GNR,TLieferungen.QSNR,TLieferungen.SNR FROM TRegionen RIGHT JOIN (TGebiete RIGHT JOIN (TGrosslagen RIGHT JOIN (TGemeinden RIGHT JOIN (((TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR) LEFT JOIN TUmrechnung ON TLieferungen.Oechsle = TUmrechnung.Oechsle) LEFT JOIN TQualitaetsstufen ON TLieferungen.QSNR = TQualitaetsstufen.QSNR) ON TGemeinden.GNR = TLieferungen.GNR) ON TGrosslagen.GLNR = TGemeinden.GLNR) ON TGebiete.WBGNR = TGrosslagen.WBGNR) ON TRegionen.RGNR = TGebiete.RGNR" -where1 = " WHERE Year(TLieferungen.Datum)=" + Format(Lesejahr1) + " AND TLieferungen.Gewicht>0" -order1 = " ORDER BY TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.MGNR" - -filenum = FreeFile -Open filename1 For Output As filenum - -Set rs1 = db1.OpenRecordset(query1 + where1 + order1) -While Not rs1.EOF - If Not IsNull(rs1!Betriebsnummer) Then - mg_betriebsnummer = rs1!Betriebsnummer - Else - mg_betriebsnummer = "" - End If - If Not IsNull(rs1!Nachname) Then - mg_name = rs1!Nachname - Else - mg_name = "" - End If - If Not IsNull(rs1!Vorname) Then - mg_vorname = rs1!Vorname - Else - mg_vorname = "" - End If - If Not IsNull(rs1!Straße) Then - ExtractFromStrasse rs1![Straße], mg_strasse, mg_hausnr - Else - mg_strasse = "" - mg_hausnr = "" - End If - - If Not IsNull(rs1!PLZ) Then - mg_plz = Format(rs1!PLZ, "0") - Else - mg_plz = "" - End If - - 'If left(rs1!Ort, 5) = "MERKE" Then - 'MsgBox (rs1!Ort) - 'End If - - If Not IsNull(rs1!Ort) Then - mg_ort = rs1!Ort - If (mg_strasse = "" Or mg_hausnr = "") And InStr(mg_ort, " ") > 0 Then - 'straße steht im ort - ExtractFromStrasse rs1!Ort, mg_ort, mg_hausnr - End If - Else - mg_ort = "" - End If - If Not IsNull(rs1!Datum) Then - li_datum = Format(rs1!Datum, "dd.mm.yyyy") - Else - li_datum = "" - End If - If Not IsNull(rs1!Gewicht) Then - li_menge = Format(rs1!Gewicht) - Else - li_menge = "" - End If - - li_art = "TB" - - li_weiss = "" - li_rot = "" - If Not IsNull(rs1!Typ) Then - If rs1!Typ = "Weiß" Then - li_weiss = "J" - End If - If rs1!Typ = "Rot" Then - li_rot = "J" - End If - End If - If Not IsNull(rs1!SNR) Then - li_sorte1 = Left(rs1!SNR, 2) - Else - li_sorte1 = "" - End If - li_sorte2 = "" - li_sorte3 = "" - - If Not IsNull(rs1![TQualitaetsstufen.BKIKuerzel]) Then - li_qualitaetsstufe = rs1![TQualitaetsstufen.BKIKuerzel] - Else - li_qualitaetsstufe = "" - End If - - li_jahrgang = Format(Lesejahr1) - - - 'obsolet - 'If Not IsNull(rs1![TRegionen.BKIKuerzel]) Then - ' li_herkunft = rs1![TRegionen.BKIKuerzel] - 'Else - ' li_herkunft = "" - 'End If - - 'If rs1![SNR] = "DAC" Then - ' li_sorte1 = "GV" - ' If Not IsNull(rs1![TGebiete.BKIKuerzel]) Then - ' li_herkunft = rs1![TGebiete.BKIKuerzel] - ' End If - 'End If - - If Not IsNull(rs1!SNR) And Not IsNull(rs1!QSNR) And Not IsNull(rs1!GNR) Then - li_herkunft = GetHerkunftBKI(rs1!SNR, rs1!QSNR, rs1!GNR) - Else - li_herkunft = "" - 'hardcoded - If rs1!QSNR < 3 Then - If rs1!QSNR < 2 Then - li_herkunft = "OEST" - Else - li_herkunft = "WLXX" - End If - Else - If UCase(Left(rs1!SNR, 2)) = "GV" Then - li_herkunft = "WLWV" - Else - li_herkunft = "WLNO" - End If - End If - End If - - If Not IsNull(rs1!KW) Then - li_kwm = rs1!KW - Else - li_kwm = "" - End If - - If Not IsNull(rs1!Oechsle) Then - li_oechsle = rs1!Oechsle - Else - li_oechsle = "" - End If - - mg_vollablieferer = "N" - mg_hagesamt = "" - mg_haertrag = "" - 'mg_flaechenbindung = "" - - mg_flaechenbindung = Format(Get_Flaechenbindung(rs1!MGNR, Lesejahr1)) - - - line1 = wg_betriebsnummer + Chr(9) + wg_name + Chr(9) + wg_vorname + Chr(9) + wg_strasse + Chr(9) + wg_hausnr + Chr(9) + wg_plz + Chr(9) + wg_ort + Chr(9) - line1 = line1 + mg_betriebsnummer + Chr(9) + mg_name + Chr(9) + mg_vorname + Chr(9) + mg_strasse + Chr(9) + mg_hausnr + Chr(9) + mg_plz + Chr(9) + mg_ort + Chr(9) - line1 = line1 + li_datum + Chr(9) + li_menge + Chr(9) + li_art + Chr(9) + li_weiss + Chr(9) + li_rot + Chr(9) + li_sorte1 + Chr(9) + li_sorte2 + Chr(9) + li_sorte3 + Chr(9) + li_qualitaetsstufe + Chr(9) + li_jahrgang + Chr(9) + li_herkunft + Chr(9) + li_kwm + Chr(9) + li_oechsle + Chr(9) - line1 = line1 + mg_vollablieferer + Chr(9) + mg_hagesamt + Chr(9) + mg_haertrag + Chr(9) + mg_flaechenbindung - Print #filenum, line1 - rcount = rcount + 1 - gcount = gcount + rs1!Gewicht - rs1.MoveNext -Wend -rs1.Close -Close filenum -DoCmd.Hourglass False -MsgBox (Format(rcount) + " Lieferungen exportiert. Gesamtgewicht: " + Format(gcount) + " kg") - - - -End Sub - -Function Get_Flaechenbindung(mgnr1 As Long, Lesejahr1 As Long) As Double - -Dim x - -x = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(mgnr1) + " AND Von<=" + Format(Lesejahr1) + " AND (Bis>=" + Format(Lesejahr1) + " or Bis=Null)") - -If IsNull(x) Then - Get_Flaechenbindung = 0 -Else - Get_Flaechenbindung = x -End If - -End Function - - - -Function Fileexists(filename As String) As Boolean - -On Error GoTo NoFile - -If FileSystem.GetAttr(filename) >= 0 Then - Fileexists = True -Else - Fileexists = False -End If - -Exit Function - -NoFile: - Fileexists = False - Exit Function - -End Function - - -Public Function Runden(value1 As Double, digits As Integer) As Double - -Dim temp1 As Double - -temp1 = value1 * (10 ^ digits) - -If (temp1 * 10) Mod 10 = 5 Then - temp1 = temp1 + 1 - temp1 = Fix(temp1) - temp1 = temp1 / (10 ^ digits) - Runden = temp1 -Else - Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits) -End If - -End Function - -Sub ExtractFromStrasse(str1 As String, strasse1 As String, hausnummer1 As String) - -Dim rightestspacepos As Long - -If IsNumeric(str1) Then - hausnummer1 = str1 - strasse1 = "" -Else - rightestspacepos = Len(str1) - While Mid(str1, rightestspacepos, 1) <> " " And rightestspacepos > 1 - rightestspacepos = rightestspacepos - 1 - Wend - - - 'If InStr(str1, " ") > 0 Then - If rightestspacepos > 1 Then - 'strasse1 = left(str1, InStr(str1, " ") - 1) - 'hausnummer1 = Mid(str1, InStr(str1, " ") + 1) - strasse1 = Left(str1, rightestspacepos - 1) - hausnummer1 = Mid(str1, rightestspacepos + 1) - Else - strasse1 = str1 - hausnummer1 = "" - End If -End If - -End Sub - - diff --git a/wgmaster/vba/form/Form_MExportMitglieder.frm b/wgmaster/vba/form/Form_MExportMitglieder.frm deleted file mode 100644 index 7789cc0..0000000 --- a/wgmaster/vba/form/Form_MExportMitglieder.frm +++ /dev/null @@ -1,412 +0,0 @@ - -'Globals for data exchange with export functions - -Dim mgnr1 As String -Dim nachname1 As String -Dim vorname1 As String -Dim strasse1 As String -Dim plz1 As String -Dim ort1 As String -Dim betriebsnummer1 As String -Dim ga1 As String -Dim ga2 As String -Dim eintrittsdatum1 As String -Dim austrittsdatum1 As String -Dim buchführend1 As String -Dim anmerkung1 As String -Dim aktivesmitglied1 As String - -Dim bhkontonr1 As String -Dim blz1 As String -Dim bankname1 As String -Dim bankname2 As String -Dim kontonr1 As String - -Dim zweigstelle1 As String - -'Globals for bmd export - -Dim Branche1 As String -Dim Auslandscode1 As String -Dim Zahlungsziel1 As String -Dim Skonto1 As String -Dim Skonto2 As String -Dim Mahncode1 As String -Dim Verkaufsgebiet1 As String - -Private Sub BOk_Click() - -If Fileexists(TExportDatei) Then - If MsgBox("Datei " + TExportDatei + " existiert bereits ! Überschreiben", vbYesNo) = vbYes Then - ExportMitglieder (TExportDatei) - DoCmd.Close - End If -Else - If Not IsNull(TExportDatei) And TExportDatei <> "" Then - ExportMitglieder (TExportDatei) - DoCmd.Close - Else - MsgBox "Bitte geben Sie eine Exportdatei an !", vbCritical - End If -End If - -End Sub - - -Private Sub Form_Close() - -If Not IsNull(TExportDatei) And TExportDatei <> "" Then - Select Case OExportOption - Case 1: ' CDF - SetParameter "MITGLIEDEREXPORTDATEI1", TExportDatei - Case 2: ' BMD - SetParameter "MITGLIEDEREXPORTDATEI2", TExportDatei - End Select - -End If - -SetParameter "MITGLIEDEREXPORTDEFAULT", OExportOption - -End Sub - - - -Private Sub Form_Open(Cancel As Integer) - -If IsNull(GetParameter("MITGLIEDEREXPORTDEFAULT")) Then - SetParameter "MITGLIEDEREXPORTDEFAULT", 1 -End If - -OExportOption = GetParameter("MITGLIEDEREXPORTDEFAULT") - -Select Case OExportOption - -Case 1: 'CDF - If IsNull(GetParameter("MITGLIEDEREXPORTDATEI1")) Then - SetParameter "MITGLIEDEREXPORTDATEI1", "C:\MITGLIEDER.TXT" - End If - TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI1") -Case 2: 'BMD - If IsNull(GetParameter("MITGLIEDEREXPORTDATEI2")) Then - SetParameter "MITGLIEDEREXPORTDATEI2", "C:\PEKOSTAM.BMD" - End If - TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI2") - -End Select - -End Sub - - - -Function Fileexists(filename As String) As Boolean - -On Error GoTo NoFile - -If FileSystem.GetAttr(filename) >= 0 Then - Fileexists = True -Else - Fileexists = False -End If - -Exit Function - -NoFile: - Fileexists = False - Exit Function - -End Function - - -Sub ExportMitglieder(filename1 As String) - -Dim db1 As Database -Dim rs_mitglieder As Recordset -Dim query1 As String -Dim Lesejahr1 As Long -Dim rcounter As Long -Dim line1 As String -Dim filenum - -DoCmd.Hourglass True - -query1 = "SELECT TMitglieder.*, TZweigstellen.Name, TBanken.Name1, TBanken.Name2, TMitglieder.Nachname, TMitglieder.Vorname FROM (TBanken RIGHT JOIN TMitglieder ON TBanken.BLZ = TMitglieder.BLZ) LEFT JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR ORDER BY TMitglieder.Nachname, TMitglieder.Vorname" - -Set db1 = CurrentDb -Set rs_mitglieder = db1.OpenRecordset(query1) - -rcounter = 0 -sum_netto1 = 0 -sum_mwst1 = 0 -sum_brutto1 = 0 - -filenum = FreeFile - -On Error GoTo err1: -Open filename1 For Output As filenum - - Select Case OExportOption - - Case 1: ' CDF - PrintMitgliederCDFHeader (filenum) - Case 2: ' BMD - PrintMitgliederBMDHeader (filenum) - End Select - -While Not rs_mitglieder.EOF - - mgnr1 = Format(rs_mitglieder![MGNR]) - If IsNull(rs_mitglieder![TMitglieder.Nachname]) Then nachname1 = "" Else nachname1 = rs_mitglieder![TMitglieder.Nachname] - If IsNull(rs_mitglieder![TMitglieder.Vorname]) Then vorname1 = "" Else vorname1 = rs_mitglieder![TMitglieder.Vorname] - If IsNull(rs_mitglieder![Straße]) Then strasse1 = "" Else strasse1 = rs_mitglieder![Straße] - If IsNull(rs_mitglieder![PLZ]) Then plz1 = "" Else plz1 = rs_mitglieder!PLZ - If IsNull(rs_mitglieder!Ort) Then ort1 = "" Else ort1 = rs_mitglieder!Ort - - If IsNull(rs_mitglieder!BLZ) Then blz1 = "" Else blz1 = rs_mitglieder!BLZ - If IsNull(rs_mitglieder!KontoNr) Then kontonr1 = "" Else kontonr1 = rs_mitglieder!KontoNr - If IsNull(rs_mitglieder!BHKontonummer) Then bhkontonr1 = "" Else bhkontonr1 = rs_mitglieder!BHKontonummer - If IsNull(rs_mitglieder!Name1) Then bankname1 = "" Else bankname1 = rs_mitglieder!Name1 - If IsNull(rs_mitglieder!Name2) Then bankname2 = "" Else bankname2 = rs_mitglieder!Name2 - - If IsNull(rs_mitglieder!Name) Then zweigstelle1 = "" Else zweigstelle1 = rs_mitglieder!Name - - If IsNull(rs_mitglieder!Betriebsnummer) Then betriebsnummer1 = "" Else betriebsnummer1 = rs_mitglieder!Betriebsnummer - If IsNull(rs_mitglieder![Geschäftsanteile1]) Then ga1 = "" Else ga1 = rs_mitglieder![Geschäftsanteile1] - If IsNull(rs_mitglieder![Geschäftsanteile2]) Then ga2 = "" Else ga2 = rs_mitglieder![Geschäftsanteile2] - - If IsNull(rs_mitglieder![Eintrittsdatum]) Then eintrittsdatum1 = "" Else eintrittsdatum1 = Format(rs_mitglieder![Eintrittsdatum], "dd.mm.yyyy") - If IsNull(rs_mitglieder![Austrittsdatum]) Then austrittsdatum1 = "" Else austrittsdatum1 = Format(rs_mitglieder![Austrittsdatum], "dd.mm.yyyy") - - If rs_mitglieder![Buchführend] Then buchführend1 = "buchführend" Else buchführend1 = "" - - If IsNull(rs_mitglieder![Anmerkung]) Then anmerkung1 = "" Else anmerkung1 = rs_mitglieder![Anmerkung] - If rs_mitglieder![Aktives Mitglied] Then aktivesmitglied1 = "aktiv" Else aktivesmitglied1 = "" - - ' output to file - - Select Case OExportOption - - Case 1: ' CDF - PrintMitgliederCDFData (filenum) - Case 2: ' BMD - PrintMitgliederBMDData (filenum) - End Select - - rs_mitglieder.MoveNext - rcounter = rcounter + 1 -Wend - -Close filenum -rs_mitglieder.Close - -DoCmd.Hourglass False - -MsgBox (Format(rcounter) + " Mitglieder erfolgreich exportiert !") -Exit Sub - -err1: - MsgBox "Datei bereits geöffnet !", vbCritical - DoCmd.Hourglass False - -End Sub - -Private Sub OExportOption_Click() - -Select Case OExportOption - -Case 1: 'CDF - If IsNull(GetParameter("MITGLIEDEREXPORTDATEI1")) Then - SetParameter "MITGLIEDEREXPORTDATEI1", "C:\MITGLIEDER.TXT" - End If - TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI1") -Case 2: 'BMD - If IsNull(GetParameter("MITGLIEDEREXPORTDATEI2")) Then - SetParameter "MITGLIEDEREXPORTDATEI2", "C:\PEKOSTAM.BMD" - End If - TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI2") - -End Select - - - - -End Sub - - - - - -' ****************************************************************************** -' THE EXPORT ROUTINES -' ****************************************************************************** - - -' ****************************************************************************** -' CDF EXPORT -' ****************************************************************************** - - -Sub PrintMitgliederCDFData(filenumber) - -Dim s1 As String -s1 = ";" - -Print #filenumber, mgnr1 + s1 + nachname1 + s1 + vorname1 + s1 + strasse1 + s1 + plz1 + s1 + ort1 + s1 + kontonr1 + s1 + blz1 + s1 + bankname1 + s1 + bankname2 + s1 + zweigstelle1 + s1 + betriebsnummer1 + s1 + ga1 + s1 + ga2 + s1 + Format(eintrittsdatum1) + s1 + Format(austrittsdatum1) + s1 + buchführend1 + s1 + aktivesmitglied1 - -End Sub - - -Sub PrintMitgliederCDFHeader(filenumber) - -Dim line1 As String -Dim s1 As String -s1 = ";" -line1 = "" - -Print #filenumber, "MITGLIEDERLISTE" - -Print #filenumber, "" -Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "KONTONUMMER" + s1 + "BLZ" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "ZWEIGSTELLE" + s1 + "BETRIEBSNUMMER" + s1 + "GESCHÄFTSANTEILE1" + s1 + "GESCHÄFTSANTEILE2" + s1 + "EINTRITT" + s1 + "AUSTRITT" + s1 + "BUCHFÜHREND" + s1 + "AKTIVES MITGLIED" - -End Sub - - -' ****************************************************************************** -' BMD EXPORT -' ****************************************************************************** - - -Sub PrintMitgliederBMDData(filenumber) - -Dim line1 As String -Dim str1 As String - -line1 = "" -str1 = "" - -'bhkontonr -str1 = FillUp(bhkontonr1, 6, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'bezeichnung (name) -str1 = FillUp(nachname1 + " " + vorname1, 30, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'branche -str1 = FillUp(Branche1, 25, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'straße -str1 = FillUp(strasse1, 20, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'plz -str1 = FillUp(plz1, 7, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'ort -str1 = FillUp(ort1, 20, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'bankkonto -str1 = FillUp(kontonr1, 20, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'blz -str1 = FillUp(blz1, 6, 0, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'auslandscode -str1 = FillUp(Auslandscode1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'Zahlungsziel -str1 = FillUp(Zahlungsziel1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'skonto % -str1 = FillUp(Skonto1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'skonto tage -str1 = FillUp(Skonto2, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'mahncode -str1 = FillUp(Mahncode1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'verkaufsgebiet -str1 = FillUp(Verkaufsgebiet1, 3, 1, "0") -line1 = line1 + str1 -'MsgBox (str1) - -'platzhalter " "x47 -str1 = FillUp(" ", 47, 1, " ") -line1 = line1 + str1 -'MsgBox (str1) - -'stern -str1 = "*" -line1 = line1 + str1 -'MsgBox (str1) - -Print #filenumber, line1 - -End Sub - - - -Sub PrintMitgliederBMDHeader(filenumber) - -'DoCmd.OpenForm - -Branche1 = " " -Auslandscode1 = "000" -Zahlungsziel1 = "000" -Skonto1 = "000" -Skonto2 = "000" -Mahncode1 = "000" -Verkaufsgebiet1 = "000" - -DoCmd.Hourglass True - -End Sub - - -Function FillUp(text1 As String, laenge1 As Long, left1 As Long, fillchar1 As String) As String - -Dim str1 As String - -str1 = text1 - -If Len(str1) > laenge1 Then -' it is too long - str1 = Left(str1, laenge1) -End If - -While (Len(str1) < laenge1) - ' it is still too short - If left1 Then - str1 = fillchar1 + str1 - Else - str1 = str1 + fillchar1 - End If -Wend - - -FillUp = str1 - -End Function \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MHauptmenü.frm b/wgmaster/vba/form/Form_MHauptmenü.frm deleted file mode 100644 index aff23e2..0000000 --- a/wgmaster/vba/form/Form_MHauptmenü.frm +++ /dev/null @@ -1,113 +0,0 @@ -Private Sub BChargen_Click() - -DoCmd.OpenForm "MChargenAuswahl" - -End Sub - -Private Sub BMitglieder_Click() - -DoCmd.OpenForm "FMitglieder" - -End Sub - -Private Sub BLieferungen_Click() - -'Dim lj - -'lj = InputBox("Für welches Lesejahr wollen Sie die Lieferungen bearbeiten ?", "LESEJAHR", Year(Date)) - -'On Error Resume Next -'If Not IsNull(lj) And lj <> "" Then -' If CLng(lj) > 1900 Then -' DoCmd.OpenForm "FLieferungen", , , "Year(Datum)=" + Format(lj) -' End If -'End If -DoCmd.OpenForm "MLieferungAuswahl" - -End Sub - -Private Sub BAuswertungen_Click() - -DoCmd.OpenForm "MAuswertung" - - -End Sub - -Private Sub BStammdaten_Click() - -DoCmd.OpenForm "MStammdaten" - -End Sub - -Private Sub BAuszahlung_Click() - -DoCmd.OpenForm "MAuszahlung" - -End Sub - -Private Sub BAdministration_Click() - -On Error Resume Next -DoCmd.DeleteObject acForm, "MAdministrationCopy" -DoCmd.CopyObject , "MAdministrationCopy", acForm, "MAdministration" -DoCmd.OpenForm "MAdministrationCopy" - -End Sub - -Private Sub BÜbernahme_Click() - -Dim lj - - -lj = InputBox("Bitte geben Sie das Lesejahr ein:", "LESEJAHR", year(Date)) - -On Error Resume Next -If Not IsNull(lj) And lj <> "" Then - If CLng(lj) > 1900 Then - DoCmd.OpenForm "FÜbernahme", , , "Year(Datum)=" + Format(lj) - End If -End If -End Sub - -Private Sub Bild14_DblClick(Cancel As Integer) - -'DoCmd.ShowToolbar "Menüleiste", acToolbarYes -'DoCmd.ShowToolbar "Formularansicht", acToolbarYes -'DoCmd.ShowToolbar "Datenbank", acToolbarYes -SwitchToolbars (True) -End Sub - -Private Sub BLeseplanung_Click() - -Dim lj - -lj = InputBox("Bitte geben Sie das Lesejahr ein:", "LESEJAHR", year(Date)) - -On Error Resume Next -If Not IsNull(lj) And lj <> "" Then - If CLng(lj) > 1900 Then - DoCmd.OpenForm "FLeseplanung", , , "Year(Datum)=" + Format(lj) - Forms("FLeseplanung").Lesejahr = lj - Forms("FLeseplanung").SetLesejahr (lj) - End If -End If - - - -End Sub - -Private Sub Form_Close() - -DoCmd.ShowToolbar "Menüleiste", acToolbarYes -DoCmd.ShowToolbar "Formularansicht", acToolbarYes -DoCmd.ShowToolbar "Datenbank", acToolbarYes - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -DoCmd.ShowToolbar "Menüleiste", acToolbarNo -DoCmd.ShowToolbar "Formularansicht", acToolbarNo -DoCmd.ShowToolbar "Datenbank", acToolbarNo - -End Sub diff --git a/wgmaster/vba/form/Form_MImport.frm b/wgmaster/vba/form/Form_MImport.frm deleted file mode 100644 index 039ffee..0000000 --- a/wgmaster/vba/form/Form_MImport.frm +++ /dev/null @@ -1,659 +0,0 @@ - - -Private Sub BOk_Click() - -DoCmd.Hourglass True -ImportLieferungen TImportFile -ImportMitglieder TImportFile -ImportChargen TImportFile -DoCmd.Hourglass False -SetParameter "ImportPfad", TImportFile -DoCmd.Close - - -End Sub - - -Sub ImportLieferungen(filename As String) - -Dim db1 As Database -Dim rs1 As Recordset -Dim db2 As Database -Dim rs2 As Recordset -Dim rs3 As Recordset -Dim rs4 As Recordset -Dim item1 As Integer - -Dim tempfilename1 As String -Dim filename1 As String -Dim tempfilename2 As String -Dim filename2 As String -Dim query1 As String -Dim query2 As String -Dim Lesejahr1 As Long -Dim ZNR1 As Long -Dim newLINR As Long -Dim oldLINR As Long -Dim newFBNR As Long - -Dim endwhile1 - -' get lesejahr1/znr1 - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - - On Error GoTo TableNotFound - - If IsNull(db1.TableDefs("xTLieferungen")) Then Exit Sub - - Set rs1 = db1.OpenRecordset("xTLieferungen") - - ' TLieferungen does not exist - If IsNull(rs1) Then Exit Sub - - Lesejahr1 = year(rs1!Datum) - ZNR1 = rs1!ZNR - rs1.Close - db1.Close - -'TLieferungen - filename1 = "TLieferungen" - tempfilename1 = "xTLieferungen" - tempfilename2 = "xTLieferungAbschlag" - filename2 = "TLieferungAbschlag" - - query1 = "SELECT * FROM xTLieferungen ORDER BY LINR" - query2 = "SELECT * FROM xTLieferungAbschlag ORDER BY LINR" - - DoCmd.Hourglass False -If MsgBox("Sollen vorhandene Lieferungen der Zweigstelle " + Format(ZNR1) + " vom Lesejahr " + Format(Lesejahr1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then - DoCmd.Hourglass True - Set db2 = CurrentDb - db2.Execute ("DELETE TLieferungAbschlag.* FROM TLieferungAbschlag RIGHT JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";") - db2.Execute ("DELETE * FROM TLieferungen WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";") - - - If IsNull(DMax("LINR", "TLieferungen")) Then - newLINR = 0 - Else - newLINR = DMax("LINR", "TLieferungen") - End If - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(query1, dbOpenSnapshot) - Set rs2 = db2.OpenRecordset(filename1, dbOpenDynaset, dbAppendOnly) - Set rs3 = db1.OpenRecordset(query2, dbOpenSnapshot) - Set rs4 = db2.OpenRecordset(filename2, dbOpenDynaset, dbAppendOnly) - - While Not rs1.EOF - - ' Insert TLieferungen - newLINR = newLINR + 1 - rs2.AddNew - - - For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - - oldLINR = rs1!LINR - rs2!LINR = newLINR - rs2.Update - - - ' Insert TLieferungAbschlag and substitute new LINR - - endwhile1 = 0 - While endwhile1 = 0 - If rs3.EOF Then - endwhile1 = 1 - Else - If rs3!LINR >= oldLINR Then - endwhile1 = 1 - Else - rs3.MoveNext - End If - End If - - Wend - - endwhile1 = 0 - While endwhile1 = 0 - If rs3.EOF Then - endwhile1 = 1 - Else - If rs3!LINR = oldLINR Then - - rs4.AddNew - For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1 - rs4(item1) = rs3(item1) - Next item1 - - rs4!LINR = newLINR - rs4.Update - rs3.MoveNext - - Else - endwhile1 = 1 - End If - End If - - Wend - - rs1.MoveNext - Wend - - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Lieferungen importiert") - DoCmd.Hourglass True - - rs1.Close - rs2.Close - rs3.Close - rs4.Close - db1.Close - db2.Close - - -End If - -Exit Sub - -TableNotFound: - - Exit Sub - -End Sub - - - - - -Sub ImportMitglieder(filename As String) - -Dim db1 As Database -Dim rs1 As Recordset -Dim db2 As Database -Dim rs2 As Recordset -Dim rs3 As Recordset -Dim rs4 As Recordset -Dim item1 As Integer - -Dim tempfilename1 As String -Dim filename1 As String -Dim tempfilename2 As String -Dim filename2 As String -Dim query1 As String -Dim query2 As String -Dim Lesejahr1 As Long -Dim ZNR1 As Long -Dim newLINR As Long -Dim oldLINR As Long -Dim newFBNR As Long - -Dim endwhile1 - -' get lesejahr1/znr1 - - On Error GoTo TableNotFound - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set rs1 = db1.OpenRecordset("xTMitglieder") - If IsNull(rs1) Then Exit Sub - - ZNR1 = rs1!ZNR - rs1.Close - db1.Close - - -'TMitglieder - filename1 = "TMitglieder" - tempfilename1 = "xTMitglieder" - tempfilename2 = "xTFlaechenbindungen" - filename2 = "TFlaechenbindungen" - - query1 = "SELECT * FROM xTMitglieder ORDER BY MGNR" - query2 = "SELECT * FROM xTFlaechenbindungen ORDER BY MGNR" - - DoCmd.Hourglass False - - If MsgBox("Sollen vorhandene Mitglieder der Zweigstelle " + Format(ZNR1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then - DoCmd.Hourglass True - Set db2 = CurrentDb - db2.Execute ("DELETE TFlaechenbindungen.* FROM TFlaechenbindungen RIGHT JOIN TMitglieder ON TFlaechenbindungen.MGNR = TMitglieder.MGNR WHERE ZNR=" + Format(ZNR1) + ";") - db2.Execute ("DELETE * FROM TMitglieder WHERE ZNR=" + Format(ZNR1) + ";") - - - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(tempfilename1) - Set rs2 = db2.OpenRecordset(filename1) - - While Not rs1.EOF - ' Insert TMitglieder - rs2.AddNew - - For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2.Update - rs1.MoveNext - Wend - - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Mitglieder importiert") - DoCmd.Hourglass True - - rs1.Close - rs2.Close - db1.Close - db2.Close - - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(tempfilename2) - Set rs2 = db2.OpenRecordset(filename2) - - If IsNull(DMax("FBNR", "TFlaechenbindungen")) Then - newFBNR = 0 - Else - newFBNR = DMax("FBNR", "TFlaechenbindungen") - End If - - While Not rs1.EOF - ' Insert TFlaechenbindungen - newFBNR = newFBNR + 1 - rs2.AddNew - - For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2!FBNR = newFBNR - rs2.Update - rs1.MoveNext - Wend - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Flächenbindungen importiert") - - rs1.Close - rs2.Close - db1.Close - db2.Close - - End If - - -Exit Sub - -TableNotFound: - - Exit Sub - -End Sub - - -Sub ImportChargen(filename As String) - -Dim db1 As Database -Dim rs1 As Recordset -Dim db2 As Database -Dim rs2 As Recordset -Dim rs3 As Recordset -Dim rs4 As Recordset -Dim item1 As Integer - -Dim tempfilename1 As String -Dim filename1 As String -Dim tempfilename2 As String -Dim filename2 As String -Dim query1 As String -Dim query2 As String -Dim Lesejahr1 As Long -Dim ZNR1 As Long -Dim newCNR As Long -Dim oldCNR As Long - -Dim endwhile1 - -' get lesejahr1/znr1 - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - - On Error GoTo TableNotFound - - If IsNull(db1.TableDefs("xTChargen")) Then Exit Sub - - Set rs1 = db1.OpenRecordset("xTChargen") - - ' TChargen does not exist - If IsNull(rs1) Then Exit Sub - - Lesejahr1 = rs1!Jahrgang - ZNR1 = rs1!ZNR - rs1.Close - db1.Close - -'TChargen - filename1 = "TChargen" - tempfilename1 = "xTChargen" - - query1 = "SELECT * FROM xTChargen ORDER BY CNR" - - DoCmd.Hourglass False -If MsgBox("Sollen vorhandene Chargen der Zweigstelle " + Format(ZNR1) + " vom Lesejahr " + Format(Lesejahr1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then - DoCmd.Hourglass True - Set db2 = CurrentDb - db2.Execute ("DELETE * FROM TChargen WHERE ZNR=" + Format(ZNR1) + " AND Year(Jahrgang)=" + Format(Lesejahr1) + ";") - - If IsNull(DMax("CNR", "TChargen")) Then - newCNR = 0 - Else - newCNR = DMax("CNR", "TChargen") - End If - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(query1, dbOpenSnapshot) - Set rs2 = db2.OpenRecordset(filename1, dbOpenDynaset, dbAppendOnly) - - While Not rs1.EOF - - ' Insert TChargen - newCNR = newCNR + 1 - rs2.AddNew - - - For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - - oldCNR = rs1!CNR - rs2!CNR = newCNR - rs2.Update - - ' Change CNR in TLieferungen - Set rs3 = db2.OpenRecordset("SELECT * FROM TLieferungen WHERE CNR=" + Format(oldCNR)) - While Not rs3.EOF - rs3.Edit - rs3("CNR") = newCNR - rs3.Update - rs3.MoveNext - Wend - rs3.Close - - rs1.MoveNext - Wend - - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Chargen importiert") - DoCmd.Hourglass True - - rs1.Close - rs2.Close - db1.Close - db2.Close - - -End If - -Exit Sub - -TableNotFound: - - Exit Sub - -End Sub - - - - - - - - - - - - - - - - -Sub ImportAll(filename As String) - -Dim db1 As Database -Dim rs1 As Recordset -Dim db2 As Database -Dim rs2 As Recordset -Dim rs3 As Recordset -Dim rs4 As Recordset -Dim item1 As Integer - -Dim tempfilename1 As String -Dim filename1 As String -Dim tempfilename2 As String -Dim filename2 As String -Dim query1 As String -Dim query2 As String -Dim Lesejahr1 As Long -Dim ZNR1 As Long -Dim newLINR As Long -Dim oldLINR As Long -Dim newFBNR As Long - -Dim endwhile1 - -' get lesejahr1/znr1 - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set rs1 = db1.OpenRecordset("xTLieferungen") - If IsNull(rs1) Then - Else - Lesejahr1 = year(rs1!Datum) - ZNR1 = rs1!ZNR - rs1.Close - db1.Close - End If - -'TLieferungen - filename1 = "TLieferungen" - tempfilename1 = "xTLieferungen" - tempfilename2 = "xTLieferungAbschlag" - filename2 = "TLieferungAbschlag" - - query1 = "SELECT * FROM xTLieferungen ORDER BY LINR" - query2 = "SELECT * FROM xTLieferungAbschlag ORDER BY LINR" - - DoCmd.Hourglass False - -If MsgBox("Sollen vorhandene Lieferungen der Zweigstelle " + Format(ZNR1) + " vom Lesejahr " + Format(Lesejahr1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then - DoCmd.Hourglass True - Set db2 = CurrentDb - db2.Execute ("DELETE TLieferungAbschlag.* FROM TLieferungAbschlag RIGHT JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";") - db2.Execute ("DELETE * FROM TLieferungen WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";") - - - - newLINR = DMax("LINR", "TLieferungen") - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(query1, dbOpenSnapshot) - Set rs2 = db2.OpenRecordset(filename1, dbOpenDynaset, dbAppendOnly) - Set rs3 = db1.OpenRecordset(query2, dbOpenSnapshot) - Set rs4 = db2.OpenRecordset(filename2, dbOpenDynaset, dbAppendOnly) - - While Not rs1.EOF - - ' Insert TLieferungen - newLINR = newLINR + 1 - rs2.AddNew - - - For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - - oldLINR = rs1!LINR - rs2!LINR = newLINR - rs2.Update - - - ' Insert TLieferungAbschlag and substitute new LINR - - endwhile1 = 0 - While endwhile1 = 0 - If rs3.EOF Then - endwhile1 = 1 - Else - If rs3!LINR >= oldLINR Then - endwhile1 = 1 - Else - rs3.MoveNext - End If - End If - - Wend - - endwhile1 = 0 - While endwhile1 = 0 - If rs3.EOF Then - endwhile1 = 1 - Else - If rs3!LINR = oldLINR Then - - rs4.AddNew - For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1 - rs4(item1) = rs3(item1) - Next item1 - - rs4!LINR = newLINR - rs4.Update - rs3.MoveNext - - Else - endwhile1 = 1 - End If - End If - - Wend - - rs1.MoveNext - Wend - - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Lieferungen importiert") - DoCmd.Hourglass True - - rs1.Close - rs2.Close - rs3.Close - rs4.Close - db1.Close - db2.Close - - -End If - - - - -'TMitglieder - filename1 = "TMitglieder" - tempfilename1 = "xTMitglieder" - tempfilename2 = "xTFlaechenbindungen" - filename2 = "TFlaechenbindungen" - - query1 = "SELECT * FROM xTMitglieder ORDER BY MGNR" - query2 = "SELECT * FROM xTFlaechenbindungen ORDER BY MGNR" - - DoCmd.Hourglass False - - If MsgBox("Sollen vorhandene Mitglieder der Zweigstelle " + Format(ZNR1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then - - DoCmd.Hourglass True - Set db2 = CurrentDb - db2.Execute ("DELETE TFlaechenbindungen.* FROM TFlaechenbindungen RIGHT JOIN TMitglieder ON TFlaechenbindungen.MGNR = TMitglieder.MGNR WHERE ZNR=" + Format(ZNR1) + ";") - db2.Execute ("DELETE * FROM TMitglieder WHERE ZNR=" + Format(ZNR1) + ";") - - - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(tempfilename1) - Set rs2 = db2.OpenRecordset(filename1) - - While Not rs1.EOF - ' Insert TMitglieder - rs2.AddNew - - For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2.Update - rs1.MoveNext - Wend - - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Mitglieder importiert") - DoCmd.Hourglass True - - rs1.Close - rs2.Close - db1.Close - db2.Close - - - Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename) - Set db2 = CurrentDb - - Set rs1 = db1.OpenRecordset(tempfilename2) - Set rs2 = db2.OpenRecordset(filename2) - - newFBNR = DMax("FBNR", "TFlaechenbindungen") - While Not rs1.EOF - ' Insert TFlaechenbindungen - newFBNR = newFBNR + 1 - rs2.AddNew - - For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1 - rs2(item1) = rs1(item1) - Next item1 - rs2!FBNR = newFBNR - rs2.Update - rs1.MoveNext - Wend - DoCmd.Hourglass False - MsgBox (Format(rs1.recordcount) + " Flächenbindungen importiert") - - rs1.Close - rs2.Close - db1.Close - db2.Close - - End If - - - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -Dim filename - -filename = GetParameter("ImportPfad") - -If Len(filename) > 0 Then - TImportFile = filename -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MLeseauswertung.frm b/wgmaster/vba/form/Form_MLeseauswertung.frm deleted file mode 100644 index 0eb732b..0000000 --- a/wgmaster/vba/form/Form_MLeseauswertung.frm +++ /dev/null @@ -1,342 +0,0 @@ - -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 diff --git a/wgmaster/vba/form/Form_MLieferscheinBereinigung.frm b/wgmaster/vba/form/Form_MLieferscheinBereinigung.frm deleted file mode 100644 index 08c5426..0000000 --- a/wgmaster/vba/form/Form_MLieferscheinBereinigung.frm +++ /dev/null @@ -1,111 +0,0 @@ - -Dim f_linr(0 To 1000) As Long -Dim f_count As Long - -Private Sub BLöschen_Click() - -Dim i As Integer -If MsgBox("Wollen Sie die ausgewählten Lieferungen wirklich löschen?", vbYesNo) = vbYes Then - - For i = 0 To LLieferungen.ListCount - 1 - If LLieferungen.Selected(i) Then - If DFirst("Gewicht", "TLieferungen", "LINR=" + Format(LLieferungen.ItemData(i))) > 0 Then - If MsgBox("Die Lieferung mit LINR=" + Format(LLieferungen.ItemData(i)) + " enthält ein Gewicht > 0. Wollen Sie sie wirklich löschen ?", vbYesNo) = vbYes Then - 'Löschen - LieferscheinLöschen (LLieferungen.ItemData(i)) - End If - Else - 'Löschen - LieferscheinLöschen (LLieferungen.ItemData(i)) - End If - End If - Next i - LLieferungen.Requery -End If - -End Sub - -Sub LieferscheinLöschen(LINR1 As Long) - -Dim db1 As Database - -Set db1 = CurrentDb -db1.Execute ("DELETE * FROM TLieferungAbschlag WHERE LINR=" + Format(LINR1) + ";") -db1.Execute ("DELETE * FROM TLieferungen WHERE LINR=" + Format(LINR1) + ";") - -End Sub - -Private Sub BWeiter_Click() - -TLesejahr = TLesejahr - 1 -BuildList - -End Sub - -Private Sub BZurueck_Click() - -TLesejahr = TLesejahr + 1 -BuildList - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -If Month(Date) > 7 Then - TLesejahr = year(Date) -Else - TLesejahr = year(Date) - 1 -End If -BuildList - -End Sub - -Private Sub LLieferungen_DblClick(Cancel As Integer) - -If LLieferungen.ListIndex >= 0 Then - DoCmd.OpenForm "FLieferungen", , , "LINR=" + Format(LLieferungen.ItemData(LLieferungen.ListIndex + 1)) -End If - -End Sub - -Private Sub TLesejahr_Exit(Cancel As Integer) - -BuildList - -End Sub - - -Sub BuildList() - -Dim db1 As Database -Dim rs1 As Recordset -Dim where2 As String -Dim query1 As String -Dim where1 As String -Dim order1 As String -Dim order2 As String - -query1 = "SELECT LINR, Lieferscheinnummer, TLieferungen.Datum, TLieferungen.Uhrzeit, TLieferungen.SNR, TSorten.Bezeichnung, TLieferungen.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TLieferungen.Gewicht, TLieferungen.Oechsle, TLieferungen.Storniert FROM TMitglieder RIGHT JOIN (TSorten RIGHT JOIN TLieferungen ON TSorten.SNR = TLieferungen.SNR) ON TMitglieder.MGNR = TLieferungen.MGNR" -order2 = " ORDER BY LINR" -f_count = 0 -where2 = "AND Year(TLieferungen.Datum)=" + Format(TLesejahr) -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT LINR FROM TMitglieder RIGHT JOIN (TSorten RIGHT JOIN TLieferungen ON TSorten.SNR = TLieferungen.SNR) ON TMitglieder.MGNR = TLieferungen.MGNR WHERE (Lieferscheinnummer Is Null Or Nachname is null or Bezeichnung is null or Oechsle is null or Gewicht is null) " + where2 + order2) -While Not rs1.EOF - f_linr(f_count) = rs1!LINR - f_count = f_count + 1 - rs1.MoveNext -Wend -rs1.Close - -where1 = " WHERE LINR IN (-1," -For i = 0 To f_count - 1 - where1 = where1 + Format(f_linr(i)) + "," -Next i -where1 = Left(where1, Len(where1) - 1) + ")" -order1 = " ORDER BY LINR" - -LLieferungen.RowSource = query1 + where1 + order1 -LLieferungen.Requery - -End Sub diff --git a/wgmaster/vba/form/Form_MLieferungAuswahl.frm b/wgmaster/vba/form/Form_MLieferungAuswahl.frm deleted file mode 100644 index 89e39a3..0000000 --- a/wgmaster/vba/form/Form_MLieferungAuswahl.frm +++ /dev/null @@ -1,148 +0,0 @@ - -Dim lastLINR - -Private Sub BBearbeiten_Click() - -If LLieferungen >= 0 Then - lastLINR = LLieferungen - DoCmd.OpenForm "FLieferungen", acNormal, , "LINR=" + Format(LLieferungen) -End If - -End Sub - -Private Sub BChargenZuordnen_Click() - -If MsgBox("Wollen Sie alle Lieferungen des ausgewählten Lesejahres und der ausgewählten Zweigstelle automatisch eine Charge zuordnen? (Es werden nur Chargen zugeordnet, wenn nicht bereits eine Charge zugeordnet ist)", vbYesNo) = vbYes Then - If TZNR > 0 Then - ChargenZuLieferungenZuordnen TLesejahr, TZNR - Else - ChargenZuLieferungenZuordnen (TLesejahr) - End If -End If -LLieferungen.Requery - -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 Form_Activate() - -RefreshAll - -End Sub - -Private Sub Form_Load() - - -If Month(Date) < 8 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If - -TSortierung = "Datum, Uhrzeit" - -lastLINR = -1 - -RefreshAll - - - -End Sub - -Private Sub LLieferungen_DblClick(Cancel As Integer) - -lastLINR = LLieferungen - -DoCmd.OpenForm "FLieferungen", acNormal, , "LINR=" + Format(LLieferungen) - - -End Sub - -Private Sub TLesejahr_Exit(Cancel As Integer) - -RefreshAll - -End Sub - -Function GetFilter() As String - -Dim filter1 - -filter1 = "Year(Datum)=" + Format(TLesejahr) - -If Not IsNull(TZNR) Then - filter1 = filter1 + " AND TLieferungen.ZNR=" + TZNR -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.LINR, 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 TLieferungen.LINR, TLieferungen.Lieferscheinnummer AS Lieferscheinnr, TLieferungen.Datum, Format(TLieferungen.Uhrzeit,'hh:nn') AS Zeit, TMitglieder.MGNR, [Nachname]+' '+IIf(IsNull([Vorname]),'',[Vorname]) AS Mitglied, TSorten.Bezeichnung AS Sorte, TSortenAttribute.Attribut, TLieferungen.Gewicht As kg, TLieferungen.Oechsle As Oe, 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) LEFT JOIN TSortenAttribute ON TLieferungen.SANR = TSortenAttribute.SANR" -query1 = "SELECT TLieferungen.LINR, TLieferungen.Lieferscheinnummer AS Lieferscheinnr, TLieferungen.Datum, Format(TLieferungen.Uhrzeit,'hh:nn') AS Zeit, TMitglieder.MGNR, [Nachname]+' '+IIf(IsNull([Vorname]),'',[Vorname]) AS Mitglied, TSorten.Bezeichnung AS Sorte, TSortenAttribute.Attribut, TLieferungen.Gewicht AS kg, TLieferungen.Oechsle AS Oe, IIf(Storniert=True,'STORNIERT',Left(TLieferungen.Anmerkung,20)) AS Info, TChargen.Chargennummer FROM ((TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR) LEFT JOIN TSortenAttribute ON TLieferungen.SANR = TSortenAttribute.SANR) LEFT JOIN TChargen ON TLieferungen.CNR = TChargen.CNR" - - -filter1 = GetFilter -query1 = query1 + " WHERE " + filter1 + GetOrder -'MsgBox (query1) -LLieferungen.RowSource = query1 -LLieferungen.Requery - -LLieferungen.SetFocus - -If lastLINR = -1 And LLieferungen.ListCount > 0 Then -'MsgBox (LLieferungen.ItemData(1)) - LLieferungen = LLieferungen.ItemData(1) -End If - -If lastLINR >= 0 Then - LLieferungen = lastLINR -End If - - -End Sub - -Private Sub TSortierung_Change() - -RefreshAll - -End Sub - -Private Sub TZNR_Change() - -RefreshAll - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MLieferungSuchen.frm b/wgmaster/vba/form/Form_MLieferungSuchen.frm deleted file mode 100644 index df4cae3..0000000 --- a/wgmaster/vba/form/Form_MLieferungSuchen.frm +++ /dev/null @@ -1,78 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - -Dim mgnr1 -Dim lieferscheinnummer1 -Dim Lesejahr1 - -mgnr1 = TMGNR.Value -lieferscheinnummer1 = TLieferscheinnummer.Value -Lesejahr1 = TLesejahr.Value - - -If OAuswahl = 1 Then -DoCmd.Close - -Forms!FLieferungen!TMGNR.SetFocus -Forms!FLieferungen.filter = "Year(Datum)=" + Format(Lesejahr1) -DoCmd.FindRecord mgnr1, acEntire, , , , acCurrent - -Else - If OAuswahl = 2 Then - DoCmd.Close - Forms!FLieferungen!TLieferscheinnummer.SetFocus - DoCmd.FindRecord lieferscheinnummer1, acEntire, , , , acCurrent - - End If - -End If - - - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -OAuswahl = 2 - -If Month(Date) < 9 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If - -End Sub - -Private Sub TLieferscheinnummer_Change() - -OAuswahl.Value = 2 - -End Sub - -Private Sub TMGNR_Change() - -OAuswahl.Value = 1 - -End Sub - -Private Sub TMGNR_Exit(Cancel As Integer) -TMitglied = TMGNR -End Sub - -Private Sub TMitglied_Change() - -TMGNR = TMitglied -OAuswahl.Value = 1 - - -End Sub - -Private Sub TMitglied_Exit(Cancel As Integer) -TMGNR = TMitglied -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MMandantenauswahl.frm b/wgmaster/vba/form/Form_MMandantenauswahl.frm deleted file mode 100644 index 3e7b452..0000000 --- a/wgmaster/vba/form/Form_MMandantenauswahl.frm +++ /dev/null @@ -1,471 +0,0 @@ -Private Sub BAendern_Click() - -Dim str1 As String, str2 As String, oldpath As String - -If Not IsNull(LMandanten) And LMandanten >= 0 Then - - str1 = "" - While str1 = "" - str1 = InputBox("Geben Sie bitte die Mandantenbezeichnung ein:", "Mandanten bearbeiten", DMax("[Bezeichnung]", "Mandanten", "[MANR]=" + Format(LMandanten))) - Wend - - str2 = "" - While str2 = "" - str2 = InputBox("Geben Sie bitte den Datenpfad ein:", "Mandanten bearbeiten", DMax("[Data]", "Mandanten", "[MANR]=" + Format(LMandanten))) - Wend - - Dim db1 As Database - Dim rs1 As Recordset - - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("Mandanten") - - While Not rs1.EOF And rs1!MANR <> CLng(LMandanten) - rs1.MoveNext - Wend - - rs1.Edit - oldpath = rs1!Data - rs1!Bezeichnung = str1 - rs1!Data = str2 - rs1.Update - rs1.Close - - LMandanten.Requery - 'If MsgBox("Wollen Sie die Daten kopieren", vbYesNo) = vbYes Then - ' - ' If oldpath <> str2 Then - ' FileCopy oldpath, str2 - ' End If - 'End If -End If - -End Sub - -Private Sub BLoeschen_Click() - -If Not IsNull(LMandanten) And LMandanten >= 0 Then - -If MsgBox("Sind Sie sicher, daß Sie diesen Mandanten löschen wollen ?", vbYesNo) = vbYes Then - - Dim db1 As Database - Dim rs1 As Recordset - - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("Mandanten") - - While Not rs1.EOF And rs1!MANR <> CLng(LMandanten) - rs1.MoveNext - Wend - - rs1.Delete - rs1.Close - - LMandanten.Requery -End If - -End If - -End Sub - -Private Sub BNeu_Click() - -Dim str1, str2 As String - - str1 = "" - While str1 = "" - str1 = InputBox("Geben Sie bitte die Mandantenbezeichnung ein:", "Mandanten bearbeiten") - Wend - - str2 = "" - While str2 = "" - str2 = InputBox("Geben Sie bitte den Datenpfad ein:", "Mandanten bearbeiten", AppPath + "WGDATEN.ACCDB") - Wend - - Dim db1 As Database - Dim rs1 As Recordset - - Set db1 = CurrentDb - Set rs1 = db1.OpenRecordset("Mandanten") - - rs1.AddNew - rs1!Bezeichnung = str1 - rs1!Data = str2 - rs1.Update - rs1.Close - - LMandanten.Requery - - If InStr(str2, "\") > 0 Then - If MsgBox("Soll das Daten-Verzeichnis erstellt werden ?", vbYesNo) = vbYes Then - ' Verzeichnis erstellen - FileSystem.MkDir Mid(GetPathWithoutFilename(str2), 1, Len(GetPathWithoutFilename(str2)) - 1) - End If - End If - - If MsgBox("Wollen Sie eine neue Daten-Datei anlegen ?", vbYesNo) = vbYes Then - FileCopy GetAppPath + "WGDATEN.ACCDB", str2 - End If - -End Sub - -Private Sub BOk_Click() - -Weiter - -End Sub - - - - -Private Sub BRücksichern_Click() - - -Dim datapath1 -Dim apppath1 -Dim archname -Dim archname1 -Dim archname2 -Dim cmdstr1 - -Dim sicherungspfad1 As String - - - -If MsgBox("Sind Sie sicher, daß Sie sämtliche Daten von Diskette rücksichern wollen ? Alle aktuellen WG MASTER Daten auf der Festplatte gehen dabei verloren !!!", vbYesNo) = vbYes Then - - If IsNull(GetParameter("SICHERUNGSPFAD")) Then - SetParameter "SICHERUNGSPFAD", "A:\" - End If - - sicherungspfad1 = GetParameter("SICHERUNGSPFAD") - - str1 = InputBox("Bitte geben Sie den Pfad ein, von wo WG MASTER rücksichern soll: ", "Sicherungspfad eingeben", sicherungspfad1) - If Not IsNull(str1) And str1 <> "" Then - sicherungspfad1 = str1 - SetParameter "SICHERUNGSPFAD", sicherungspfad1 - End If - - archname = "wgdata.arj" - archname2 = sicherungspfad1 + archname - - datapath1 = GetDataPath - apppath1 = GetAppPath - archname1 = GetPathWithoutFilename(GetDataPath) + archname - - On Error GoTo Error1 - - If Not IsNull(datapath1) And Not IsNull(apppath1) Then - - - MsgBox ("Bitte Medium in Laufwerk " + sicherungspfad1 + " einlegen (Diskette, ZIP-Medium)") - - If Fileexist(Format(archname2)) = False Then - MsgBox "FEHLER: Sicherungsdatei nicht gefunden !", vbCritical - Exit Sub - Else - If Fileexist(Format(archname1)) Then FileSystem.Kill (archname1) - DoCmd.Hourglass True - FileCopy archname2, archname1 - If Fileexist(Format(datapath1)) Then FileSystem.Kill (datapath1) - - FileSystem.ChDrive Left(GetDataPath, 1) - FileSystem.ChDir GetPathWithoutFilename(GetDataPath) - cmdstr1 = apppath1 + "arj.exe x -y " + archname1 + " " + GetPathWithoutFilename(GetDataPath) + " " + "WGDATEN.ACCDB" - 'MsgBox (cmdstr1) - Shell cmdstr1, vbNormalFocus - FileSystem.ChDir apppath1 - - DoCmd.Hourglass False - MsgBox ("Daten erfolgreich rückgesichert") - End If - - End If - - Exit Sub - -End If - -Error1: - MsgBox "FEHLER: Datenträger nicht bereit!", vbCritical - DoCmd.Hourglass False - Exit Sub - - - -End Sub - -Private Sub BSichern_Click() - -Dim datapath1 -Dim apppath1 -Dim archname -Dim archname1 -Dim archname2 -Dim cmdstr1 -Dim sicherungspfad1 As String -Dim str1 - -If IsNull(GetParameter("SICHERUNGSPFAD")) Then - SetParameter "SICHERUNGSPFAD", "A:\" -End If - -sicherungspfad1 = GetParameter("SICHERUNGSPFAD") - -str1 = InputBox("Bitte geben Sie den Pfad ein, wohin WG MASTER sichern soll: ", "Sicherungspfad eingeben", sicherungspfad1) -If Not IsNull(str1) And str1 <> "" Then - sicherungspfad1 = str1 - SetParameter "SICHERUNGSPFAD", sicherungspfad1 -End If - - -archname = "wgdata.arj" -archname2 = sicherungspfad1 + archname - -datapath1 = GetDataPath -apppath1 = GetAppPath -archname1 = GetPathWithoutFilename(GetDataPath) + archname - -'MsgBox (datapath1) -'MsgBox (apppath1) -'MsgBox (archname1) -'MsgBox (archname2) - -On Error GoTo Error1 - -If Not IsNull(datapath1) And Not IsNull(apppath1) Then - DoCmd.Hourglass True - - - If Fileexist(Format(archname1)) = True Then FileSystem.Kill (archname1) - - FileSystem.ChDrive Left(GetDataPath, 1) - FileSystem.ChDir GetPathWithoutFilename(GetDataPath) - cmdstr1 = apppath1 + "arj.exe a " + archname1 + " " + "WGDATEN.ACCDB" - 'MsgBox (cmdstr1) - Shell cmdstr1, vbNormalFocus - FileSystem.ChDir apppath1 - - MsgBox ("Bitte Medium in Laufwerk " + sicherungspfad1 + " einlegen (Diskette, ZIP-Medium)") - - If Fileexist(Format(archname2)) Then FileSystem.Kill (archname2) - - FileCopy archname1, archname2 - FileSystem.Kill archname1 - If Fileexist(Format(archname1)) Then FileSystem.Kill (archname1) - - DoCmd.Hourglass False - MsgBox ("Daten erfolgreich gesichert") -End If - -Exit Sub - -Error1: - MsgBox "FEHLER: Datenträger nicht bereit!", vbCritical - DoCmd.Hourglass False - Exit Sub - - - - -End Sub - -Private Sub Form_Close() - -'docmd.quit - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -LMandanten.SetFocus -If Not IsNull(LMandanten.ItemData(0)) Then LMandanten = LMandanten.ItemData(0) - -End Sub - -Private Sub LMandanten_DblClick(Cancel As Integer) - -Weiter - -End Sub - -Sub Weiter() - -If Not IsNull(LMandanten) And LMandanten >= 0 Then - - Dim manr1 As Long - Dim Data As String - Dim datapath As String - - DoCmd.Hourglass True - - manr1 = LMandanten - - Data = DMax("[Data]", "Mandanten", "MANR=" + Format(manr1)) - - 'MsgBox (data) - - If FileSystem.FileLen(Data) > 0 Then - - datapath = GetPathWithoutFilename(Data) - - 'MsgBox ("1") - - SetLinkTablePath "", Data - - - - - 'Check runtime or full version - If UCase(Right(CurrentDb.Name, 1)) = "B" Then 'MDB or ACCDB - - - If manr1 <> GetLastMANR() Then - SetLastMANR (manr1) - SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP" - End If - - - 'Vollupdate prüfen - 'MsgBox ("2") - DoCmd.OpenForm "MHauptmenü", acDesign - - If Forms("MHauptmenü").XVersion2.Caption = "Vollupdate" Then - '1. Logo aktualisieren - - 'MsgBox ("3") - SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP" - - - '2. SQL Statements ausführen - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - ' Current Database for SQL Statements - Dim db2 As Database - Dim rs1 As Recordset - - - Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(GetDataPath()) - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - - If cnt1.Name = "Tables" Then - For Each doc1 In cnt1.Documents - If doc1.Name = "Update_SQLStatements" Then - Set rs1 = db1.OpenRecordset("Update_SQLStatements") - While Not rs1.EOF - 'If MsgBox(rs1!Beschreibung + " ?", vbYesNo) = vbYes Then - On Error Resume Next - db2.Execute (rs1!SQLStatement) - 'End If - rs1.MoveNext - Wend - rs1.Close - db1.Execute ("DROP Table Update_SQLStatements") - End If - Next doc1 - End If - - Next cnt1 - - '3. Übernahmeformular - Kommunikationsparameter einstellen - 'DoCmd.OpenForm "FÜbernahme", acDesign - - 'MsgBox (GetParameter("WAAGEPORTSETTINGS")) - 'MsgBox (CLng(GetParameter("WAAGEPORT"))) - 'MsgBox (CLng(GetParameter("STEUERUNGPORT"))) - - 'Forms!FÜbernahme!XComm.Settings = GetParameter("WAAGEPORTSETTINGS") - 'Forms!FÜbernahme!XComm.CommPort = CLng(GetParameter("WAAGEPORT")) - 'Forms!FÜbernahme!XCommSteuerung.CommPort = CLng(GetParameter("STEUERUNGPORT")) - - 'DoCmd.Save - 'DoCmd.Close - - '4. Vollupdate Label entfernen - Forms("MHauptmenü").XVersion2.Caption = "" - DoCmd.Save - - End If - - DoCmd.Close - - End If - - DoCmd.Hourglass False - DoCmd.OpenForm "MHauptmenü" - - End If - - - -End If - -End Sub - -Function SetReportControlProperty1(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant) -' Sets the given property of the given control in the given form to the given value -' If Formname="" then all forms -' If Controlname="" then all controls - -Dim sec1 As Section -Dim ctl1 As Control -Dim i As Variant - -If reportname = "" Or IsNull(reportname) Then -'All Reports - Dim db1 As Database - Dim cnt1 As Container - Dim doc1 As Document - - Set db1 = CurrentDb - For Each cnt1 In db1.Containers - If cnt1.Name = "Reports" Then - For Each doc1 In cnt1.Documents - DoCmd.OpenReport doc1.Name, acViewDesign - - On Error Resume Next - 'look into all sections - For i = 0 To 8 - 'If Reports(doc1.Name).Section(i).Visible = True Then - Reports(doc1.Name).Controls(ControlName).Properties(PropertyName) = PropertyValue - 'Set sec1 = Reports(doc1.Name).Section(i) - 'For Each ctl1 In sec1.Controls - 'If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - 'If Controltype = ctl1.Controltype Or Controltype = -1 Then - 'On Error Resume Next - 'ctl1.Properties(PropertyName) = PropertyValue - 'End If - 'End If - 'Next ctl1 - 'End If - Next i - DoCmd.Save - DoCmd.Close - Next doc1 - End If - Next cnt1 - -Else - DoCmd.OpenReport reportname, acViewDesign - For i = 0 To 8 - Set sec1 = Reports(reportname).Section(i) - For Each ctl1 In sec1.Controls - If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then - On Error Resume Next - ctl1.Properties(PropertyName) = PropertyValue - End If - Next ctl1 - Next i - DoCmd.Save - DoCmd.Close -End If - - - - - -End Function \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MMitgliederKonsistenz.frm b/wgmaster/vba/form/Form_MMitgliederKonsistenz.frm deleted file mode 100644 index a47cc70..0000000 --- a/wgmaster/vba/form/Form_MMitgliederKonsistenz.frm +++ /dev/null @@ -1,134 +0,0 @@ -Dim temptablename1 As String - - -Private Sub Form_Open(Cancel As Integer) - -Dim db1 As Database - -LMitglieder.RowSource = "" -LMitglieder.Requery - - -temptablename1 = "xTempMitgliederInkonsistent" -Set db1 = CurrentDb -If TableExists(temptablename1) Then - db1.Execute ("DROP TABLE " + temptablename1) -End If -db1.Execute ("CREATE TABLE " + temptablename1 + " (MGNR LONG, ProblemKurz TEXT, Problem MEMO);") - -FlaechenbindungenBerechnen (year(Now)) - -CheckConsistency - -LMitglieder.RowSource = "SELECT TMitglieder.MGNR AS MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Ort, TMitglieder.Geschäftsanteile1 AS GA1, TMitglieder.Geschäftsanteile2 AS GA2, TMitglieder.Eintrittsdatum AS Eintritt, TMitglieder.Austrittsdatum AS Austritt, TMitglieder.[Aktives Mitglied] AS Aktiv, xTempFlaechenbindungen.Gesamtflaeche AS Flaeche, xTempMitgliederInkonsistent.ProblemKurz AS Problem FROM (TMitglieder INNER JOIN xTempMitgliederInkonsistent ON TMitglieder.MGNR = xTempMitgliederInkonsistent.MGNR) LEFT JOIN xTempFlaechenbindungen ON TMitglieder.MGNR = xTempFlaechenbindungen.MGNR ORDER BY TMitglieder.MGNR" -LMitglieder.Requery - - -End Sub - - -Function TableExists(table1) As Boolean - -Dim db1 As Database -Set db1 = CurrentDb -Dim x As TableDef - -For Each x In db1.TableDefs - If x.Name = table1 Then - TableExists = True - Exit Function - End If -Next x - -TableExists = False - -End Function - -Sub CheckConsistency() - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim aktlesejahr As Long - -Set db1 = CurrentDb -Set rs2 = db1.OpenRecordset(temptablename1) - - -Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE Austrittsdatum<>Null and [Aktives Mitglied]=true") -While Not rs1.EOF - rs2.AddNew - rs2("MGNR") = rs1("MGNR") - rs2("ProblemKurz") = "AUSTRITTSDATUM ABER AKTIV" - rs2("Problem") = "Mitglied hat Austrittsdatum eingetragen und ist trotzdem als aktiv eingetragen" - rs2.Update - rs1.MoveNext -Wend -rs1.Close - -Set rs1 = db1.OpenRecordset("SELECT TMitglieder.MGNR FROM TMitglieder INNER JOIN xTempFlaechenbindungen ON TMitglieder.MGNR = xTempFlaechenbindungen.MGNR WHERE [Aktives Mitglied]=false and Gesamtflaeche>0") -While Not rs1.EOF - - rs2.AddNew - rs2("MGNR") = rs1("MGNR") - rs2("ProblemKurz") = "FLÄCHENBINDG TROTZ INAKTIV" - rs2("Problem") = "Mitglied ist als nicht aktiv eingetragen, es sind aber noch gültige Flächenbindungen vorhanden" - rs2.Update - rs1.MoveNext -Wend -rs1.Close - -Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE (Geschäftsanteile1>0 or Geschäftsanteile2>0) and [Aktives Mitglied]=false") -While Not rs1.EOF - rs2.AddNew - rs2("MGNR") = rs1("MGNR") - rs2("ProblemKurz") = "GA TROTZ INAKTIV" - rs2("Problem") = "Mitglied ist als nicht aktiv eingetragen, hat aber Geschäftsanteile eingetragen" - rs2.Update - rs1.MoveNext -Wend -rs1.Close - -If Month(Now) < 11 Then - aktlesejahr = year(Now) - 1 -Else - aktlesejahr = year(Now) -End If - -Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE [Aktives Mitglied]=True AND MGNR NOT IN (SELECT DISTINCT MGNR FROM TLieferungen WHERE Year([Datum])>=" + Format(aktlesejahr - 2) + ")") -While Not rs1.EOF - rs2.AddNew - rs2("MGNR") = rs1("MGNR") - rs2("ProblemKurz") = "3 JAHRE KEINE LIEFERUNG" - rs2("Problem") = "Mitglied ist als aktiv eingetragen, hat aber bereits 3 Jahre hintereinander nichts geliefert" - rs2.Update - rs1.MoveNext -Wend -rs1.Close - -Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE Austrittsdatum=NULL and [Aktives Mitglied]=false") -While Not rs1.EOF - rs2.AddNew - rs2("MGNR") = rs1("MGNR") - rs2("ProblemKurz") = "KEIN AUSTRITTSDATUM" - rs2("Problem") = "Mitglied hat kein Austrittsdatum eingetragen und ist nicht als aktiv eingetragen" - rs2.Update - rs1.MoveNext -Wend -rs1.Close - - - -rs2.Close - - -End Sub - -Private Sub LMitglieder_DblClick(Cancel As Integer) - -DoCmd.OpenForm "FMitglieder", , , "MGNR=" + Format(LMitglieder) -Forms("FMitglieder")!OAlleMitglieder = True -Forms("FMitglieder").RequeryListe -Forms("FMitglieder")!LMitglieder = LMitglieder - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MMitgliederliste.frm b/wgmaster/vba/form/Form_MMitgliederliste.frm deleted file mode 100644 index ee46660..0000000 --- a/wgmaster/vba/form/Form_MMitgliederliste.frm +++ /dev/null @@ -1,113 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - - -Dim SEL1 As String -Dim where1 As String -Dim order1 As String -Dim reportname As String - - -FlaechenbindungenBerechnen (TJahr) - -If ODetails = True Then - reportname = "BMitgliederlisteDetails" - SEL1 = "SELECT TZweigstellen.Name, TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Betriebsnummer, TMitglieder.Ort, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.Eintrittsdatum, TMitglieder.[Aktives Mitglied], TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.BLZ, TMitglieder.KontoNr, TMitglieder.Eintrittsdatum, TMitglieder.Buchführend, TMitglieder.UID, xTempFlaechenbindungen.Gesamtflaeche FROM (TMitglieder LEFT JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR) LEFT JOIN xTempFlaechenbindungen ON TMitglieder.MGNR = xTempFlaechenbindungen.MGNR" - GROUP1 = "" - 'CP 2.1.2008: xTempFlaechenbindungen statt Gruppierung mit TFlaechenbindungen - 'SEL1 = "SELECT TZweigstellen.Name, TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Betriebsnummer, TMitglieder.Ort, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.Eintrittsdatum, TMitglieder.[Aktives Mitglied], Sum(TFlaechenbindungen.Flaeche) AS FlSumme, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.BLZ, TMitglieder.KontoNr, TMitglieder.Eintrittsdatum, TMitglieder.Buchführend, TMitglieder.UID FROM (TMitglieder INNER JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR) LEFT JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR" - 'GROUP1 = "GROUP BY TZweigstellen.Name, TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Betriebsnummer, TMitglieder.Ort, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.Eintrittsdatum, TMitglieder.[Aktives Mitglied], TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.BLZ, TMitglieder.KontoNr, TMitglieder.Eintrittsdatum, TMitglieder.Buchführend, TMitglieder.UID" -Else - reportname = "BMitgliederliste" - SEL1 = "SELECT TZweigstellen.Name, TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Betriebsnummer, TMitglieder.Ort, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.Eintrittsdatum, TMitglieder.[Aktives Mitglied], xTempFlaechenbindungen.Gesamtflaeche FROM (TMitglieder LEFT JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR) LEFT JOIN xTempFlaechenbindungen ON TMitglieder.MGNR = xTempFlaechenbindungen.MGNR" - GROUP1 = "" - 'CP 2.1.2008: xTempFlaechenbindungen statt Gruppierung mit TFlaechenbindungen - 'SEL1 = "SELECT TZweigstellen.Name, TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Betriebsnummer, TMitglieder.Ort, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.Eintrittsdatum, TMitglieder.[Aktives Mitglied], Sum(TFlaechenbindungen.Flaeche) AS FlSumme FROM (TMitglieder INNER JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR) LEFT JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR " - 'GROUP1 = " GROUP BY Name, TMitglieder.MGNR, Nachname, Vorname, Betriebsnummer, TMitglieder.Ort, Geschäftsanteile1, Geschäftsanteile2, Eintrittsdatum, [Aktives Mitglied] " -End If - -DoCmd.OpenReport reportname, acDesign - -'CP 2.1.2008: xTempFlaechenbindungen statt Gruppierung mit TFlaechenbindungen -'where1 = " WHERE (((TFlaechenbindungen.Von)<=[Forms]![MMitgliederliste]![TJahr] Or (TFlaechenbindungen.Von) Is Null) AND ((TFlaechenbindungen.Bis)>=[Forms]![MMitgliederliste]![TJahr] Or (TFlaechenbindungen.Bis) Is Null)) " -where1 = " WHERE TMitglieder.MGNR>0 " -If ONurAktiveMitglieder Then - 'where1 = where1 + " AND [Aktives Mitglied]=True " - 'Aktiv und noch nicht ausgetreten - where1 = where1 + " AND ([Aktives Mitglied]=True OR TMitglieder.Austrittsdatum>=DateValue('31.12." + Format([Forms]![MMitgliederliste]!TJahr) + " '))" - 'Zum Stichjahr bereits eingetreten - where1 = where1 + " AND (TMitglieder.Eintrittsdatum is Null or TMitglieder.Eintrittsdatum<=DateValue('31.12." + Format(Forms!MMitgliederliste!TJahr) + "')) " -End If - -If ONurFlaechenbindungen Then - 'CP 2.1.2008: xTempFlaechenbindungen statt Gruppierung mit TFlaechenbindungen - where1 = where1 + " AND Gesamtflaeche>0" - 'where1 = where1 + " AND TMitglieder.MGNR IN (SELECT DISTINCT TFlaechenbindungen.MGNR FROM TFlaechenbindungen WHERE Von<=" + Format(TJahr) + " AND (Bis>=" + Format(TJahr) + " OR Bis=NULL))" -End If - -'MsgBox (SEL1 + WHERE1 + ORDER1) -Reports(reportname).RecordSource = SEL1 + where1 + GROUP1 '+ ORDER1 - - -'MsgBox (SEL1 + where1 + GROUP1) - - -Reports(reportname).GroupLevel(0).ControlSource = "Name" - -Select Case OSortierung - -Case 1: 'ORDER1 = " ORDER BY TMitglieder.ZNR,Nachname,Vorname" - -Reports(reportname).GroupLevel(1).ControlSource = "Nachname" -Reports(reportname).GroupLevel(2).ControlSource = "Vorname" -Reports(reportname).Section(8).ForceNewPage = 0 -Reports(reportname)!TOrt.Visible = False - -Case 2: 'ORDER1 = " ORDER BY TMitglieder.ZNR,MGNR" - -Reports(reportname).GroupLevel(1).ControlSource = "TMitglieder.MGNR" -Reports(reportname).GroupLevel(2).ControlSource = "TMitglieder.MGNR" -Reports(reportname).Section(8).ForceNewPage = 0 -Reports(reportname)!TOrt.Visible = False - -Case 3: ' Ort - -Reports(reportname).GroupLevel(1).ControlSource = "TMitglieder.Ort" -Reports(reportname).GroupLevel(2).ControlSource = "TMitglieder.Nachname" -'Forcenewpage=2 -Reports(reportname).Section(8).ForceNewPage = 2 -Reports(reportname)!TOrt.Visible = True - - -End Select - - -DoCmd.Save -DoCmd.Close -DoCmd.OpenReport reportname, acPreview - -End Sub - - - -Private Sub Form_Open(Cancel As Integer) - -ODetails = False -ONurAktiveMitglieder = True -ONurFlaechenbindungen = False -OSortierung = 1 - -If Month(Date) < 8 Then - TJahr = year(Date) - 1 -Else - TJahr = year(Date) -End If - - -End Sub diff --git a/wgmaster/vba/form/Form_MRundschreiben.frm b/wgmaster/vba/form/Form_MRundschreiben.frm deleted file mode 100644 index 453eae1..0000000 --- a/wgmaster/vba/form/Form_MRundschreiben.frm +++ /dev/null @@ -1,143 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub Befehl54_Click() - - - -End Sub - -Private Sub BExcelExport_Click() - -Dim SEL1 As String -Dim where1 As String -Dim order1 As String -Dim query1 -Dim savepath1 - -SEL1 = "SELECT TMitglieder.* FROM TMitglieder INNER JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR" - -Select Case OSortierung - -Case 1: order1 = " ORDER BY Nachname,Vorname " -Case 2: order1 = " ORDER BY MGNR " -Case 3: order1 = " ORDER BY TMitglieder.Ort, TMitglieder.Nachname, TMitglieder.Vorname " - -End Select - -where1 = " WHERE MGNR > 0 " - -If ONurAktiveMitglieder Then - where1 = where1 + " AND [Aktives Mitglied]=True " -End If -If ONurFlaechenbindungen Then - where1 = where1 + " AND TMitglieder.MGNR IN (SELECT DISTINCT TFlaechenbindungen.MGNR FROM TFlaechenbindungen)" -End If -If Not IsNull(LZNR) And LZNR <> "" Then - where1 = where1 + " AND TMitglieder.ZNR=" + Format(LZNR) -End If - -query1 = SEL1 + where1 + order1 - - -savepath1 = InputBox("Excel Datei speichern unter:", "EXCEL DATEI EXPORTIEREN", "C:\Eigene Dateien\mitglieder.xls") -If IsNull(savepath) Or savepath1 = "" Then - Exit Sub -End If - -queryname1 = "AMitgliederExport" -Dim db1 As Database -Set db1 = CurrentDb - -On Error Resume Next -DoCmd.DeleteObject acQuery, queryname1 - -db1.CreateQueryDef queryname1, query1 -db1.Close -DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel5, queryname1, savepath1, True - -End Sub - -Function GetWhereClause() As String - -Dim where1 As String - -where1 = " WHERE MGNR >0 " - -If ONurAktiveMitglieder Then - where1 = where1 + " AND [Aktives Mitglied]=True " -End If -If ONurFlaechenbindungen Then - where1 = where1 + " AND TMitglieder.MGNR IN (SELECT DISTINCT TFlaechenbindungen.MGNR FROM TFlaechenbindungen)" -End If -If Not IsNull(LZNR) And LZNR <> "" Then - where1 = where1 + " AND TMitglieder.ZNR=" + Format(LZNR) -End If - -GetWhereClause = where1 - -End Function - -Private Sub BOk_Click() - - -Dim SEL1 As String -Dim where1 As String -Dim order1 As String - -SEL1 = "SELECT TMitglieder.MGNR, Nachname, Vorname, TMitglieder.Ort, TMitglieder.PLZ, TMitglieder.Straße, Geschäftsanteile1, Geschäftsanteile2, Eintrittsdatum, [Aktives Mitglied] FROM TMitglieder INNER JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR" - - -DoCmd.OpenReport "BRundschreiben", acDesign - -Select Case OSortierung - -Case 1: 'ORDER1 = " ORDER BY TMitglieder.ZNR,Nachname,Vorname" - -Reports!BRundschreiben.GroupLevel(0).ControlSource = "Nachname" -Reports!BRundschreiben.GroupLevel(1).ControlSource = "Vorname" - -Case 2: 'ORDER1 = " ORDER BY TMitglieder.ZNR,MGNR" - -Reports!BRundschreiben.GroupLevel(0).ControlSource = "TMitglieder.MGNR" -Reports!BRundschreiben.GroupLevel(1).ControlSource = "TMitglieder.MGNR" - -Case 3: ' Ort - -Reports!BRundschreiben.GroupLevel(0).ControlSource = "TMitglieder.Ort" -Reports!BRundschreiben.GroupLevel(1).ControlSource = "TMitglieder.Nachname" - -End Select - -where1 = GetWhereClause() - -'MsgBox (SEL1 + WHERE1 + ORDER1) -Reports!BRundschreiben.RecordSource = SEL1 + where1 '+ ORDER1 - -DoCmd.Save -DoCmd.Close -DoCmd.OpenReport "BRundschreiben", acPreview - -End Sub - -Private Sub BRundschreibenEMail_Click() - -Dim where1 As String -DoCmd.OpenForm "MRundschreibenEMail" -where1 = GetWhereClause() -where1 = where1 + " AND EMail is not null " -Forms("MRundschreibenEMail").SetWhereClause (where1) - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -ONurAktiveMitglieder = True -ONurFlaechenbindungen = False -OSortierung = 1 - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MRundschreibenEMail.frm b/wgmaster/vba/form/Form_MRundschreibenEMail.frm deleted file mode 100644 index 198b713..0000000 --- a/wgmaster/vba/form/Form_MRundschreibenEMail.frm +++ /dev/null @@ -1,83 +0,0 @@ -Dim where1 As String - -Private Sub BOk_Click() - -Dim adressen As String - -adressen = GetEMailadressen() -subject = TBetreff -body = TEMailText -If OVerdeckt Then - DoCmd.SendObject acSendReport, "Mitglieder-Information", acFormatPDF, , , adressen, subject, body -Else - DoCmd.SendObject acSendReport, "Mitglieder-Information", acFormatPDF, adressen, , , subject, body -End If -End Sub - -Function GetEMailadressen() As String - -Dim db1 As Database -Dim rs1 As Recordset -Dim adressen As String -Set db1 = CurrentDb -Set rs1 = db1.OpenRecordset("SELECT * FROM TMitglieder" + where1) -adressen = "" -While Not rs1.EOF - If Not IsNull(rs1("EMail")) Then - adressen = adressen + rs1("EMail") + ";" - End If - rs1.MoveNext -Wend -rs1.Close -adressen = Left(adressen, Len(adressen) - 1) -GetEMailadressen = adressen - -End Function - -Public Sub SetWhereClause(where2 As String) - -where1 = where2 - -LAnzahl.Caption = Format(DCount("MGNR", "TMitglieder", Mid(where1, 8))) + " Mitglieder mit E-Mail Adresse gefunden" - - -End Sub - -Private Sub Form_Close() - - SetParameter "RUNDSCHREIBENEMAIL_BETREFF", TBetreff - SetParameter "RUNDSCHREIBENEMAIL_EMAILTEXT", TEMailText - SetParameter "RUNDSCHREIBENEMAIL_TEXT", TRundschreiben - -End Sub - -Private Sub Form_Open(Cancel As Integer) - -Dim betreff As String -Dim emailtext As String -Dim rundschreiben As String - -If IsNull(GetParameter("RUNDSCHREIBENEMAIL_BETREFF")) Then - betreff = "Rundschreiben" - SetParameter "RUNDSCHREIBENEMAIL_BETREFF", betreff -End If -betreff = GetParameter("RUNDSCHREIBENEMAIL_BETREFF") - -If IsNull(GetParameter("RUNDSCHREIBENEMAIL_EMAILTEXT")) Then - emailtext = "Liebe Mitglieder" - SetParameter "RUNDSCHREIBENEMAIL_EMAILTEXT", emailtext -End If -emailtext = GetParameter("RUNDSCHREIBENEMAIL_EMAILTEXT") - - -If IsNull(GetParameter("RUNDSCHREIBENEMAIL_TEXT")) Then - rundschreiben = "Rundschreiben" - SetParameter "RUNDSCHREIBENEMAIL_TEXT", rundschreiben -End If -rundschreiben = GetParameter("RUNDSCHREIBENEMAIL_TEXT") - -TBetreff = betreff -TEMailText = emailtext -TRundschreiben = rundschreiben - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MStammblatt.frm b/wgmaster/vba/form/Form_MStammblatt.frm deleted file mode 100644 index 32d2b80..0000000 --- a/wgmaster/vba/form/Form_MStammblatt.frm +++ /dev/null @@ -1,82 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - -Dim where1 As String - -where1 = "" -If OListe = 1 Then - 'MGNR - If Not IsNull(TVon1) Then - where1 = where1 + " AND TMitglieder.MGNR>=" + Format(TVon1) - End If - If Not IsNull(TBis1) Then - where1 = where1 + " AND TMitglieder.MGNR<=" + Format(TBis1) - End If -Else - 'PLZ - If Not IsNull(TVon1) Then - where1 = where1 + " AND TMitglieder.PLZ>='" + Format(TVon1) + "'" - End If - If Not IsNull(TBis1) Then - where1 = where1 + " AND TMitglieder.PLZ<='" + Format(TBis1) + "'" - End If -End If - - -Select Case OListe - -Case 1: - DoCmd.OpenReport "BMitgliedStammblattMGNR", acPreview, , "[Aktives Mitglied]=True AND ZNR=" + Format(Forms!MStammblatt!TZNR) + where1 -Case 2: - DoCmd.OpenReport "BMitgliedStammblatt", acPreview, , "[Aktives Mitglied]=True AND ZNR=" + Format(Forms!MStammblatt!TZNR) + where1 - -End Select - -If OLiefermengen Then - DoCmd.OpenReport "BLiefermenge", acViewDesign - - Select Case OListe - Case 1: - Reports("BLiefermenge").GroupLevel(0).ControlSource = "MGNR" - Case 2: - Reports("BLiefermenge").GroupLevel(0).ControlSource = "PLZ" - End Select - - DoCmd.Save - DoCmd.Close , "BLiefermenge" - - DoCmd.OpenReport "BLiefermenge", acPreview, , "[Aktives Mitglied]=True AND ZNR=" + Format(Forms!MStammblatt!TZNR) + where1 -End If - - - -End Sub - - - - -Private Sub Form_Open(Cancel As Integer) - -OListe = 1 -OLiefermengen = False -TZNR = DFirst("ZNR", "TZweigstellen") -TFusstext = GetParameter("STAMMBLATTTEXT") - -End Sub - - -Private Sub TFusstext_Exit(Cancel As Integer) - -If IsNull(TFusstext.Value) Then - SetParameter "STAMMBLATTTEXT", " " -Else - SetParameter "STAMMBLATTTEXT", TFusstext.Value -End If - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MStammdaten.frm b/wgmaster/vba/form/Form_MStammdaten.frm deleted file mode 100644 index 8604bd2..0000000 --- a/wgmaster/vba/form/Form_MStammdaten.frm +++ /dev/null @@ -1,89 +0,0 @@ -Private Sub BBehaelter_Click() - -DoCmd.OpenForm "FBehaelter" - -End Sub - -Private Sub BBehandlungen_Click() - -DoCmd.OpenForm "FBehandlungen" - -End Sub - -Private Sub Befehl17_Click() - -DoCmd.OpenForm "FMandant" - -End Sub - -Private Sub Befehl18_Click() - -DoCmd.OpenForm "FBanken" - -End Sub - -Private Sub Befehl19_Click() - -DoCmd.OpenForm "FGebietshierarchie" - -End Sub - -Private Sub Befehl20_Click() - -DoCmd.OpenForm "MStammdaten" - -End Sub - -Private Sub Befehl22_Click() - -DoCmd.OpenForm "FSorten" - -End Sub - -Private Sub Befehl23_Click() - -DoCmd.OpenForm "FQualitaetsstufen" - -End Sub - -Private Sub Befehl24_Click() - -DoCmd.OpenForm "FUmrechnung" - -End Sub - -Private Sub Befehl25_Click() - -DoCmd.OpenForm "FAbschlaege" - -End Sub - -Private Sub Befehl26_Click() - -DoCmd.OpenForm "FAllgemein" - -End Sub - -Private Sub Befehl27_Click() - -DoCmd.OpenForm "FBewirtschaftungsarten" - -End Sub - -Private Sub Befehl30_Click() - -DoCmd.OpenForm "FSortenAttribute" - -End Sub - -Private Sub BLiefermengen_Click() - -DoCmd.OpenForm "FLiefermengen" - -End Sub - -Private Sub BTextelemente_Click() - -DoCmd.OpenForm "FTextelemente" - -End Sub \ No newline at end of file diff --git a/wgmaster/vba/form/Form_MUnterlieferungen.frm b/wgmaster/vba/form/Form_MUnterlieferungen.frm deleted file mode 100644 index 32ac7dc..0000000 --- a/wgmaster/vba/form/Form_MUnterlieferungen.frm +++ /dev/null @@ -1,287 +0,0 @@ - -Private Sub Babbrechen_Click() - -DoCmd.Close - -End Sub - -Private Sub BOk_Click() - -Dim filter1 - -'filter1 = GetFilter -filter1 = "" - -Select Case OSortierung - -Case 1: 'Null-Lieferungen - -DoCmd.OpenReport "BNulllieferungen", acViewPreview, , filter1 - -Case 2: 'Über/Unterlieferungen - -DoCmd.OpenReport "BÜberlieferungen", acViewPreview, , filter1 - -Case 3: 'Unterlieferungen lt. Flächenbindungen - -CreateTempTable -DoCmd.OpenReport "BUnterlieferungenFlächenbindung", acViewPreview - -End Select - - -End Sub - -Function GetFilter() As String - -Dim filter1 As String - -'If IsNull(TZNR) Then -' filter1 = "TLieferungen.ZNR>=0" -'Else -' filter1 = "TLieferungen.ZNR=" + Format(TZNR) -'End If - -If Not IsNull(TLesejahr) Then - filter1 = " Year(Datum)=" + Format(TLesejahr) -End If - -GetFilter = filter1 - -End Function - -Private Sub Form_Open(Cancel As Integer) - -OSortierung = 1 -TErtragsgrenze = 7500 -TErtragsgrenze.Visible = False -OAlleAnzeigen.Visible = False - -OLiefermengen = False - -If Month(Date) < 9 Then - TLesejahr = year(Date) - 1 -Else - TLesejahr = year(Date) -End If - -End Sub - - -Private Sub OLiefermengen_Click() - -If OLiefermengen = True Then - TErtragsgrenze.Visible = False -Else - TErtragsgrenze.Visible = True -End If - -End Sub - -Private Sub OSortierung_Click() - -If OSortierung = 3 Then - OLiefermengen.Visible = True - If OLiefermengen = True Then - TErtragsgrenze.Visible = False - Else - TErtragsgrenze.Visible = True - End If - OAlleAnzeigen.Visible = True - OAlleAnzeigen = False -Else - OLiefermengen.Visible = False - TErtragsgrenze.Visible = False - OAlleAnzeigen.Visible = False -End If - -End Sub - -Sub CreateTempTable() - - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim temptablename As String -Dim query1 As String -Dim Lesejahr1 -Dim ERWARTETERERTRAG - -Lesejahr1 = Forms!MUnterlieferungen!TLesejahr - -temptablename = "xTempFlabiLief" -Set db1 = CurrentDb - - -'On Error Resume Next -db1.Execute ("DELETE * FROM " + temptablename) -'db1.Execute ("CREATE TABLE " + temptablename + "(MGNR LONG,SNR STRING, SANR STRING, SUMMEFLAECHE DOUBLE,SUMMEGEWICHT DOUBLE,ERTRAG DOUBLE,ERWARTETERERTRAG DOUBLE)") - - -Set rs1 = db1.OpenRecordset(temptablename) -Set rs2 = db1.OpenRecordset("SELECT MGNR,SNR,SANR, Sum(Flaeche) AS SUMFL FROM TFlaechenbindungen WHERE Von<=" + Format(Lesejahr1) + " AND (Bis=Null OR Bis>=" + Format(Lesejahr1) + ") AND NOT ISNULL(SNR) AND NOT ISNULL(MGNR) GROUP BY SNR,SANR, MGNR") - -While Not rs2.EOF - rs1.AddNew - rs1!MGNR = rs2!MGNR - rs1!SNR = rs2!SNR - If Not IsNull(rs2("SANR")) Then - rs1!SANR = rs2!SANR - End If - rs1!SUMMEFLAECHE = rs2!SUMFL - rs1!SummeGewicht = 0 - rs1!Ertrag = 0 - rs1.Update - - rs2.MoveNext -Wend -rs2.Close -rs1.Close - - -Set db1 = CurrentDb -'MsgBox (query1) - -Set rs1 = db1.OpenRecordset("SELECT * FROM " + temptablename + " ORDER BY MGNR,SNR,SANR") - -While Not rs1.EOF - - rs1.Edit - If OLiefermengen Then - If IsNull(rs1("SANR")) Then - ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR IS NULL") - Else - ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'") - End If - Else - ERWARTETERERTRAG = TErtragsgrenze - End If - If IsNull(ERWARTETERERTRAG) Then - ERWARTETERERTRAG = 7500 - End If - rs1!ERWARTETERERTRAG = ERWARTETERERTRAG - - If IsNull(rs1("SANR")) Then - query1 = "SELECT Sum(Gewicht) AS SUMKG FROM TLieferungen WHERE Year([Datum]) = " + Format(Lesejahr1) + " And TLieferungen.Storniert <> True AND MGNR=" + Format(rs1("MGNR")) + " AND SNR='" + rs1("SNR") + "' AND SANR IS NULL" - Else - query1 = "SELECT Sum(Gewicht) AS SUMKG FROM TLieferungen WHERE Year([Datum]) = " + Format(Lesejahr1) + " And TLieferungen.Storniert <> True AND MGNR=" + Format(rs1("MGNR")) + " AND SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'" - End If - Set rs2 = db1.OpenRecordset(query1) - - If rs2.EOF Then - 'keine Lieferungen gefunden - rs1!SummeGewicht = 0 - rs1!Ertrag = 0 - Else - 'lieferung gefunden - rs1!SummeGewicht = rs2!SUMKG - rs1!Ertrag = rs2!SUMKG * 10000 / rs1!SUMMEFLAECHE - End If - rs1.Update - rs2.Close - - rs1.MoveNext -Wend -rs1.Close - -End Sub - -Sub CreateTempTable_old() - - -Dim db1 As Database -Dim rs1 As Recordset -Dim rs2 As Recordset -Dim temptablename As String -Dim query1 As String -Dim Lesejahr1 -Dim ERWARTETERERTRAG - -Lesejahr1 = Forms!MUnterlieferungen!TLesejahr - -temptablename = "xTempFlabiLief" -Set db1 = CurrentDb - - -'On Error Resume Next -db1.Execute ("DELETE * FROM " + temptablename) -'db1.Execute ("CREATE TABLE " + temptablename + "(MGNR LONG,SNR STRING, SANR STRING, SUMMEFLAECHE DOUBLE,SUMMEGEWICHT DOUBLE,ERTRAG DOUBLE,ERWARTETERERTRAG DOUBLE)") - - -Set rs1 = db1.OpenRecordset(temptablename) -Set rs2 = db1.OpenRecordset("SELECT MGNR,SNR,SANR, Sum(Flaeche) AS SUMFL FROM TFlaechenbindungen WHERE Von<=" + Format(Lesejahr1) + " AND (Bis=Null OR Bis>=" + Format(Lesejahr1) + ") AND NOT ISNULL(SNR) AND NOT ISNULL(MGNR) GROUP BY SNR,SANR, MGNR") - -While Not rs2.EOF - rs1.AddNew - rs1!MGNR = rs2!MGNR - rs1!SNR = rs2!SNR - If Not IsNull(rs2("SANR")) Then - rs1!SANR = rs2!SANR - End If - rs1!SUMMEFLAECHE = rs2!SUMFL - rs1!SummeGewicht = 0 - rs1!Ertrag = 0 - rs1.Update - - rs2.MoveNext -Wend -rs2.Close -rs1.Close - -query1 = "SELECT MGNR, UCase(SNR) AS SNR1, SANR, Sum(Gewicht) AS SUMKG FROM TLieferungen WHERE Year([Datum]) = " + Format(Lesejahr1) + " And TLieferungen.Storniert <> True GROUP BY MGNR, SNR,SANR ORDER BY MGNR,SNR, SANR" - -Set db1 = CurrentDb -'MsgBox (query1) - -Set rs2 = db1.OpenRecordset(query1) -Set rs1 = db1.OpenRecordset("SELECT * FROM " + temptablename + " ORDER BY MGNR,SNR,SANR") - -While Not rs2.EOF And Not rs1.EOF - - - If rs1!MGNR = rs2!MGNR And rs1!SNR = rs2!SNR1 And (IsNull(rs1!SANR) Or rs1!SANR = rs2!SANR) Then - rs1.Edit - rs1!SummeGewicht = rs2!SUMKG - rs1!Ertrag = rs2!SUMKG * 10000 / rs1!SUMMEFLAECHE - If OLiefermengen Then - If IsNull(rs1("SANR")) Then - ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR IS NULL") - Else - ERWARTETERERTRAG = DFirst("ErwarteteLiefermengeProHa", "TLiefermengen", "SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'") - End If - Else - ERWARTETERERTRAG = TErtragsgrenze - End If - If IsNull(ERWARTETERERTRAG) Then - ERWARTETERERTRAG = 7500 - End If - rs1!ERWARTETERERTRAG = ERWARTETERERTRAG - rs1.Update - rs1.MoveNext - Else - ' Step to next equal SNR - If rs1!MGNR = rs2!MGNR Then - - If (rs1!SNR < rs2!SNR1) Then - rs1.MoveNext - Else - rs2.MoveNext - End If - Else - ' Step to next equal MGNR - If (rs1!MGNR < rs2!MGNR) Then - rs1.MoveNext - Else - rs2.MoveNext - End If - End If - - End If - - - -Wend - - -End Sub