Exported VBA

2022-11-14 23:29:49 +01:00
parent 6348c7d6bb
commit 789f79c2f8
134 changed files with 17682 additions and 0 deletions
--- a/wgmaster/vba/Form_MMitgliederKonsistenz.frm
+++ b/wgmaster/vba/Form_MMitgliederKonsistenz.frm
@ -0,0 +1,134 @@
+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