288 lines
6.1 KiB
Plaintext
288 lines
6.1 KiB
Plaintext
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 |