143 lines
3.3 KiB
Plaintext
143 lines
3.3 KiB
Plaintext
|
|
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 |