Move wgmaster/vba/Form_* to wgmaster/vba/form/*

2023-08-14 18:45:15 +02:00
parent ec9531b1fa
commit f7efd93c59
63 changed files with 0 additions and 0 deletions
--- a/wgmaster/vba/form/Form_MRundschreiben.frm
+++ b/wgmaster/vba/form/Form_MRundschreiben.frm
@ -0,0 +1,143 @@
+
+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