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