++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++
VBA Code of the data base 'Verein-v601.mdb'
19.02.2019 
++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++

========================================================
Code of the form 'frmEWettkaempfe'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmEWettkaempfe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboTyp_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboTyp_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

cboTyp.Requery

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Call HilfeAnzeigen("einzelwettkaempfe")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical


End Sub

Private Sub cmdRueber_Click()
'--------------------------------------------------------------
'Mitglieder zuordnen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

' Wenn der Nutzer den Button "Datensatz hinzufgen" drckt, Wettkampfdaten eingibt
' und dann gleich Mitglieder zuweisen will, so geht das nicht, weil sich der neue
' Wettkampf noch nicht in der Tabelle tblWettkampf befindet, d.h. er hat noch keinen Wert
' fr wet_id. Dann kann auch kein Eintrag in die Tabelle tblMit_Wet erfolgen.
' Daher muss der neue Wettkampf erst einmal gespeichert werden.

If IsNull(txtName) Then
   MsgBox "Bitte geben Sie einen Wettkampfnamen ein!"
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lstWettkaempfe.Requery

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If IsNull(Me!lstMitglieder) Then
   MsgBox "Bitte ein Mitglied in der rechten Liste auswhlen!"
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMit_Wet", dbOpenDynaset)
rs.FindFirst "wet_id_f=" & Str(Me!wet_id) & " AND mit_id_f=" & Str(Me!lstMitglieder)

If rs.NoMatch Then
   rs.AddNew
   rs!wet_id_f = Me!wet_id
   rs!mit_id_f = Me!lstMitglieder
   rs.Update
   Me!frmEWettkaempfe_ufoMitglieder.Requery
   lstMitglieder.Requery
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZurueck_Click()
'--------------------------------------------------------------
'Mitglieder-Zuordnung rckgngig machen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If IsNull(Me!frmEWettkaempfe_ufoMitglieder!mit_id) Then
   MsgBox "Bitte ein Mitglied in der linken Liste auswhlen!"
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMit_Wet", dbOpenDynaset)
rs.FindFirst "wet_id_f=" & Str(Me!wet_id) & " AND mit_id_f=" & Str(Me!frmEWettkaempfe_ufoMitglieder!mit_id)

If rs.NoMatch Then Exit Sub

rs.Delete
rs.Close
Set rs = Nothing

Me!frmEWettkaempfe_ufoMitglieder.Requery
lstMitglieder.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Activate()
' Wenn jemand das Mitgliederformular mit einem Doppelclick auf die Mitgliederliste
' in diesem Formular ffnet und dann im Mitgliederformular ein neues Mitglied
' anlegt oder ein Mitglied lscht, muss die Liste hier aktualisiert werden.

Me!lstMitglieder.Requery

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

cmdRueber.Enabled = False
cmdZurueck.Enabled = False

Me!lstWettkaempfe.SetFocus
If Nz(lstWettkaempfe.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstWettkaempfe = Me!lstWettkaempfe.ItemData(0)
   Call lstWettkaempfe_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim lngAntwort As Long
Dim strMsgtext As String

'Gibt es in anderen Tabellen noch Datenstze, die mit dem
'zu lschenden Datensatz in Beziehung stehen?

If DCount("wet_id_f", "tblMan_Wet", "wet_id_f=" & Str(Me!wet_id)) > 0 Then
   MsgBox "Der Wettkampf kann nicht gelscht werden, weil es noch teilnehmende Mannschaften gibt!"
   Exit Sub
End If

'Sicherheitsabfrage

strMsgtext = "Wollen Sie den Wettkampf '" & Me!txtName & "' wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

'Ausfhrung der Lschung

CurrentDb.Execute "DELETE FROM tblMit_Wet WHERE wet_id_f=" & Str(Me!wet_id)
CurrentDb.Execute "DELETE FROM tblMan_Wet WHERE wet_id_f=" & Str(Me!wet_id)
CurrentDb.Execute "DELETE FROM tblWettkampf WHERE wet_id=" & Str(Me!wet_id)

Requery
lstWettkaempfe.Requery
'lstWettkaempfe = Me!wet_id

lstWettkaempfe.SetFocus
If Nz(lstWettkaempfe.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstWettkaempfe = Me!lstWettkaempfe.ItemData(0)
   Call lstWettkaempfe_AfterUpdate
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngWetId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If IsNull(txtName) Then
   MsgBox "Bitte einen Namen fr den Wettkampf eingeben!"
   txtName.SetFocus
   Exit Sub
End If

If IsNull(cboTyp) Then
   MsgBox "Bitte einen Wettkampf-Typ auswhlen!"
   cboTyp.SetFocus
   Exit Sub
End If

'Speichern

DoCmd.RunCommand (acCmdSaveRecord)
lngWetId = Me!wet_id
lstWettkaempfe.Enabled = True
lstWettkaempfe.Requery

lstWettkaempfe.SetFocus
lstWettkaempfe = lngWetId
Call lstWettkaempfe_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False

lstWettkaempfe = Null
lstWettkaempfe.Enabled = False

cboTyp = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitglieder_Click()
'--------------------------------------------------------------
'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

If errorhandling Then On Error GoTo fehlerbehandlung

cmdRueber.Enabled = True
cmdZurueck.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTyp_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If IsNull(cboTyp.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Typ wirklich ndern?", _
          vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If
End Sub

Private Sub lstMitglieder_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmMitglieder", , , , , , Me!lstMitglieder
End Sub

Private Sub lstWettkaempfe_AfterUpdate()
'--------------------------------------------------------------
'Die Daten des in der Liste angeclickten Datensatzes anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstWettkaempfe) Then Me.Recordset.FindFirst "wet_id=" & Me!lstWettkaempfe

lstMitglieder.Requery
cmdRueber.Enabled = False
cmdZurueck.Enabled = False

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie einen Wettkampfnamen ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub


========================================================
Code of the form 'frmMWettkaempfe'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMWettkaempfe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboTyp_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboTyp_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

cboTyp.Requery

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
'--------------------------------------------------------------
Call HilfeAnzeigen("mannschaftswettkaempfe")

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Einen Wettkampf lschen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim lngAntwort As Long
Dim strMsgtext As String

'Gibt es in anderen Tabellen noch Datenstze, die mit dem
'zu lschenden Datensatz in Beziehung stehen?

If DCount("wet_id_f", "tblMit_Wet", "wet_id_f=" & Str(Me!wet_id)) > 0 Then
   MsgBox "Der Wettkampf kann nicht gelscht werden, weil es noch teilnehmende Mitglieder gibt!"
   Exit Sub
End If

'Sicherheitsabfrage

strMsgtext = "Wollen Sie den Wettkampf '" & Me!txtName & "' wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

'Lschen

CurrentDb.Execute "DELETE FROM tblMit_Wet WHERE wet_id_f=" & Str(Me!wet_id)
CurrentDb.Execute "DELETE FROM tblMan_Wet WHERE wet_id_f=" & Str(Me!wet_id)
CurrentDb.Execute "DELETE FROM tblWettkampf WHERE wet_id=" & Str(Me!wet_id)

Requery
lstWettkaempfe.Requery
lstWettkaempfe = Me!wet_id
lstWettkaempfe.SetFocus
If Nz(lstWettkaempfe.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstWettkaempfe = Me!lstWettkaempfe.ItemData(0)
   Call lstWettkaempfe_AfterUpdate
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False

lstWettkaempfe = Null
lstWettkaempfe.Enabled = False

cboTyp = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdRueber_Click()
'--------------------------------------------------------------
'Zuweisung einer Mannschaft

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

' Wenn der Nutzer den Button "Datensatz hinzufgen" drckt, Wettkampfdaten eingibt
' und dann gleich Mannschaften zuweisen will, so geht das nicht, weil sich der neue
' Wettkampf noch nicht in der Tabelle tblWettkampf befindet, d.h. er hat noch keinen Wert
' fr wet_id. Dann kann auch kein Eintrag in die Tabelle tblMan_Wet erfolgen.
' Daher muss der neue Wettkampf erst einmal gespeichert werden.

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie einen Wettkampfnamen ein!"
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lstWettkaempfe.Requery

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If IsNull(Me!lstMannschaften) Then
   MsgBox "Bitte eine Mannschaft in der rechten Liste auswhlen!"
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMan_Wet", dbOpenDynaset)
rs.FindFirst "wet_id_f=" & Str(Me!wet_id) & " AND man_id_f=" & Str(Me!lstMannschaften)

If rs.NoMatch Then
   rs.AddNew
   rs!wet_id_f = Me!wet_id
   rs!man_id_f = Me!lstMannschaften
   rs.Update
   Me!frmMWettkaempfe_ufoMannschaften.Requery
   lstMannschaften.Requery
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngWetId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If Nz(txtName) = "" Then
   MsgBox "Bitte einen Namen fr den Wettkampf eingeben!"
   txtName.SetFocus
   Exit Sub
End If

If IsNull(cboTyp) Then
   MsgBox "Bitte einen Wettkampf-Typ auswhlen!"
   cboTyp.SetFocus
   Exit Sub
End If

DoCmd.RunCommand (acCmdSaveRecord)
lngWetId = Me!wet_id
lstWettkaempfe.Enabled = True
lstWettkaempfe.Requery

lstWettkaempfe.SetFocus
lstWettkaempfe = lngWetId
Call lstWettkaempfe_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZurueck_Click()
'--------------------------------------------------------------
'Mannschaft vom Wettkampf entfernen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If IsNull(Me!frmMWettkaempfe_ufoMannschaften!man_id) Then
   MsgBox "Bitte eine Mannschaft in der linken Liste auswhlen!"
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMan_Wet", dbOpenDynaset)
rs.FindFirst "wet_id_f=" & Str(Me!wet_id) & " AND man_id_f=" & Str(Me!frmMWettkaempfe_ufoMannschaften!man_id)

If rs.NoMatch Then Exit Sub

rs.Delete
rs.Close
Set rs = Nothing

Me!frmMWettkaempfe_ufoMannschaften.Requery
lstMannschaften.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Activate()
' Wenn jemand das Mannschaftenformular mit einem Doppelclick auf die Mannschaftenliste
' in diesem Formular ffnet und dann im Mannschaftenformular eine neue Mannschaft
' anlegt oder eine Mannschaft lscht, muss die Liste hier aktualisiert werden.

Me!lstMannschaften.Requery

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

cmdRueber.Enabled = False
cmdZurueck.Enabled = False

' Die folgenden Befehle stellen sicher, dass bereits unmittelbar nach dem
' ffnen des Formulars in den Kombinationsfeldern und/oder Listen Werte
' ausgewhlt werden.
' Andernfalls wren Fehlbedienungen mglich.

Me!lstWettkaempfe.SetFocus
If Nz(lstWettkaempfe.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstWettkaempfe = Me!lstWettkaempfe.ItemData(0)
   Call lstWettkaempfe_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMannschaften_Click()
'--------------------------------------------------------------
'Die Daten des in der Liste angeclickten Datensatzes anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

cmdRueber.Enabled = True
cmdZurueck.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTyp_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If IsNull(cboTyp.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Typ wirklich ndern?", _
          vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If
End Sub

Private Sub lstMannschaften_DblClick(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMannschaften", , , , , , Me!lstMannschaften

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstWettkaempfe_AfterUpdate()
'--------------------------------------------------------------
'Die Daten des in der Liste angeclickten Datensatzes anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstWettkaempfe) Then Me.Recordset.FindFirst "wet_id=" & Me!lstWettkaempfe

lstMannschaften.Requery
cmdRueber.Enabled = False
cmdZurueck.Enabled = False

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie einen Wettkampfnamen ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmBeitragssaetze'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmBeitragssaetze"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
'--------------------------------------------------------------
Call HilfeAnzeigen("beitragssaetze")
End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

' Gibt es noch Mitgliedschaften dieses Mitgliedstyps?

Set rs = CurrentDb.OpenRecordset("tblMitgliedschaft", dbOpenDynaset)
rs.FindFirst "mtyp_id_f=" & Str(Me!mtyp_id)

If rs.NoMatch Then
'Wenn nicht, dann kann gelscht werden
   
   If MsgBox("Wollen Sie den Mitgliedstyp '" & Me!txtName & "' wirklich lschen?", _
              vbYesNo + vbDefaultButton2) = vbYes Then
      CurrentDb.Execute "DELETE FROM tblBeitragssatz WHERE mtyp_id_f=" & Str(Me!mtyp_id)
      CurrentDb.Execute "DELETE FROM tblMitgliedstyp WHERE mtyp_id=" & Str(Me!mtyp_id)
      lstMitgliedertypen.Requery
      lstMitgliedertypen.SetFocus
      If Nz(lstMitgliedertypen.ListCount) > 0 Then   ' Anzeige der ersten Zeile
         Me!lstMitgliedertypen = Me!lstMitgliedertypen.ItemData(0)
         Call lstMitgliedertypen_AfterUpdate
      End If
   End If
   
Else
   MsgBox "Dieser Mitgliedstyp kann nicht gelscht werden!" & vbCrLf & _
          "Es gibt noch Mitglieder dieses Typs."
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngMtypId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie eine Bezeichnung ein!"
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand (acCmdSaveRecord)
lngMtypId = Me!mtyp_id
lstMitgliedertypen.Enabled = True
lstMitgliedertypen.Requery

' Anzeige der gespeicherten Zeile

lstMitgliedertypen.SetFocus
lstMitgliedertypen = lngMtypId
Call lstMitgliedertypen_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstMitgliedertypen = Null
lstMitgliedertypen.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Me!lstMitgliedertypen.SetFocus
If Nz(lstMitgliedertypen.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstMitgliedertypen = Me!lstMitgliedertypen.ItemData(0)
   Call lstMitgliedertypen_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitgliedertypen_AfterUpdate()
'--------------------------------------------------------------
'Die Daten des in der Liste angeclickten Datensatzes anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstMitgliedertypen) Then Me.Recordset.FindFirst "mtyp_id=" & Me!lstMitgliedertypen

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie eine Bezeichnung ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmBeitragssaetze_ufoBeitragssaetze'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmBeitragssaetze_ufoBeitragssaetze"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboBisMonat_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

'DoCmd.RunCommand acCmdSaveRecord

End Sub

Private Sub cboVonMonat_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

'DoCmd.RunCommand acCmdSaveRecord

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

'In der letzten Zeile kann ein neuer Datensatz eingefgt werden.
'Diese Zeile darf und kann nicht gelscht werden.

If IsNull(Me!satz_id) Then Exit Sub
  
'Sicherheitsabfrage

If MsgBox("Wollen Sie den Beitragssatz wirklich lschen ?", _
          vbYesNo + vbDefaultButton2) = vbYes Then
   CurrentDb.Execute "DELETE FROM tblBeitragssatz WHERE satz_id=" & _
                      Str(Me!satz_id)
   Requery
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical
    
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung


If IsNull(cboVonMonat) Then
   MsgBox "Bitte geben Sie einen von-Monat ein!"
   Cancel = True
   cboVonMonat.SetFocus
   Exit Sub
End If

If Nz(txtVonJahr) = "" Then
   MsgBox "Bitte geben Sie ein von-Jahr ein!"
   Cancel = True
   txtVonJahr.SetFocus
   Exit Sub
End If

If Not IsNumeric(txtVonJahr) Or txtVonJahr < 1900 Or txtVonJahr > 2100 Then
   MsgBox "Bitte geben Sie einen gltigen Wert fr das von-Jahr ein!"
   Cancel = True
   txtVonJahr.SetFocus
   Exit Sub
End If

If Nz(txtBetrag) = "" Then
   MsgBox "Bitte geben Sie einen Betrag ein!"
   Cancel = True
   txtBetrag.SetFocus
   Exit Sub
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical


End Sub


========================================================
Code of the form 'frmPlaetze'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmPlaetze"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboPlatztyp_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboPlatztyp_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

cboPlatztyp.Requery

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
Call HilfeAnzeigen("plaetze")
End Sub

Private Sub cmdHilfehtml_Click()
'--------------------------------------------------------------
' ffnen einer Hilfedatei im HTML-Format

If errorhandling Then On Error GoTo fehlerbehandlung

Application.FollowHyperlink "hilfe-plaetze.html", , True
Exit Sub


Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical
   
End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strMsgtext As String
Dim lngAntwort As Long
Dim rs As DAO.Recordset

strMsgtext = "Wollen Sie den " & Me!txtBezeichnung & " wirklich lschen ?"

Set rs = CurrentDb.OpenRecordset("tblTraining", dbOpenDynaset)
rs.FindFirst "pla_id_f=" & Str(Me!pla_id)

If rs.NoMatch Then
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   If lngAntwort = vbYes Then
      CurrentDb.Execute ("DELETE FROM tblPlatz WHERE pla_id=" & Str(Me!pla_id))
      lstPlaetze.Requery
      If Nz(lstPlaetze.ListCount) > 0 Then   ' Anzeige der ersten Zeile
         Me!lstPlaetze = Me!lstPlaetze.ItemData(0)
         Call lstPlaetze_AfterUpdate
      End If
      Requery
   End If
Else
  MsgBox "Der Platz kann nicht gelscht werden, weil auf ihm noch Training geplant ist."
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngPlaId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(txtBezeichnung) = "" Then
   MsgBox "Bitte geben Sie eine Bezeichnung ein!"
   txtBezeichnung.SetFocus
   Exit Sub
End If

DoCmd.RunCommand (acCmdSaveRecord)
lngPlaId = Me!pla_id
cboPlatztyp.Requery
lstPlaetze.Enabled = True
lstPlaetze.Requery

lstPlaetze.SetFocus
lstPlaetze = lngPlaId
Call lstPlaetze_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

'Wenn dieses Formular geffnet ist und gleichzeitig ein neuer Platztyp
'angelegt wird, so erscheint dieser nicht in der entsprechenden Combobox.
'Fr diese muss daher ein Requery ausgefhrt werden

cboPlatztyp.Requery

DoCmd.GoToRecord , , acNewRec
txtBezeichnung.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstPlaetze = Null
lstPlaetze.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboPlatztyp_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboPlatztyp.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Platztyp wirklich ndern?", _
          vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstPlaetze.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstPlaetze.ListCount) > 0 Then   ' Anzeige der ersten Zeile
      Me!lstPlaetze = Me!lstPlaetze.ItemData(0)
      Call lstPlaetze_AfterUpdate
   End If

Else

   Me!lstPlaetze = OpenArgs
   Call lstPlaetze_AfterUpdate

End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstPlaetze_AfterUpdate()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstPlaetze) Then Me.Recordset.FindFirst "pla_id=" & Me!lstPlaetze

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtBezeichnung_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(Me!txtBezeichnung) = "" Then
   MsgBox "Bitte geben Sie eine Bezeichnung ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmTypen_ufoMitgliedstyp'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTypen_ufoMitgliedstyp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdNeu.Enabled = False
cmdLoeschen.Enabled = False
lstMitgliedstypen = Null
lstMitgliedstypen.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngMtypId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie eine Bezeichnung ein!"
   txtName.SetFocus
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMitgliedstyp", dbOpenDynaset)
rs.FindFirst "mtyp_name='" & Me!txtName & "'"

If rs.NoMatch Then
   DoCmd.RunCommand acCmdSaveRecord
   lngMtypId = Me!mtyp_id
   lstMitgliedstypen.Enabled = True
   lstMitgliedstypen.Requery
   lstMitgliedstypen.SetFocus
   lstMitgliedstypen = lngMtypId
   Call lstMitgliedstypen_AfterUpdate
Else
  MsgBox "Der Mitgliedstyp kann nicht gespeichert werden, " & _
         "weil er bereits existiert."
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strMsgtext As String
Dim lngAntwort As Long
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset

strMsgtext = "Wollen Sie den Mitgliedstyp '" & Me!txtName & "' wirklich lschen ?"

' Gibt es noch Mitgliedschaften mit diesem Mitgliedstyp?

Set rs1 = CurrentDb.OpenRecordset("tblMitgliedschaft", dbOpenDynaset)
rs1.FindFirst "mtyp_id_f=" & Str(Me!mtyp_id)

If rs1.NoMatch Then

' Gibt es noch Beitragsstze mit diesem Mitgliedstyp?
   
   Set rs2 = CurrentDb.OpenRecordset("tblBeitragssatz", dbOpenDynaset)
   rs2.FindFirst "mtyp_id_f=" & Str(Me!mtyp_id)
   If rs2.NoMatch Then
      lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
      If lngAntwort = vbYes Then
         CurrentDb.Execute ("DELETE FROM tblMitgliedstyp WHERE mtyp_id=" & Str(Me!mtyp_id))
         lstMitgliedstypen.Requery
         Requery
         lstMitgliedstypen.SetFocus
         If Nz(lstMitgliedstypen.ListCount) > 0 Then   ' Anzeige der ersten Zeile
            Me!lstMitgliedstypen = Me!lstMitgliedstypen.ItemData(0)
            Call lstMitgliedstypen_AfterUpdate
         End If
      End If
   Else
      MsgBox "Der Mitgliedstyp kann nicht gelscht werden, " & _
             "weil es noch Beitragsstze mit diesem Typ gibt."
   End If
   
   rs2.Close
   Set rs2 = Nothing
   
Else
   
   MsgBox "Der Mitgliedstyp kann nicht gelscht werden, " & _
          "weil es noch Mitglieder mit diesem Typ gibt."

End If
    
rs1.Close
Set rs1 = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

cmdNeu.Enabled = True
cmdLoeschen.Enabled = True

Me!lstMitgliedstypen.SetFocus
If Nz(lstMitgliedstypen.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstMitgliedstypen = Me!lstMitgliedstypen.ItemData(0)
   Call lstMitgliedstypen_AfterUpdate
End If

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitgliedstypen_AfterUpdate()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstMitgliedstypen) Then Me.Recordset.FindFirst "mtyp_id=" & Me!lstMitgliedstypen

cmdNeu.Enabled = True
cmdLoeschen.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie einen Mitgliedstyp ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If
End Sub

========================================================
Code of the form 'frmTraining_ufoMitglieder'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTraining_ufoMitglieder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub txtName_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Forms!frmTraining.Controls!cmdRueber.Enabled = False
Forms!frmTraining.Controls!cmdZurueck.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmMitglieder", , , , , , Me!mit_id_f
End Sub

========================================================
Code of the form 'frmEWettkaempfe_ufoMitglieder'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmEWettkaempfe_ufoMitglieder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub txtName_Click()
'--------------------------------------------------------------
'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

If errorhandling Then On Error GoTo fehlerbehandlung

Forms!frmEWettkaempfe.Controls!cmdRueber.Enabled = False
Forms!frmEWettkaempfe.Controls!cmdZurueck.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_DblClick(Cancel As Integer)
'--------------------------------------------------------------
'ffnen des Mitglieder-Formulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMitglieder", , , , , , Me!mit_id

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmTrainer_ufoMitglieder'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTrainer_ufoMitglieder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub button_entfernen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strMsgtext As String
Dim lngAntwort As Long

strMsgtext = "Wollen Sie die Zuordnung wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

CurrentDb.Execute "UPDATE tblMitglied SET trainer_id_f=NULL WHERE mit_id=" & Str(Me!mit_id)
Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_DblClick(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMitglieder", , , , , , Me!mit_id

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmHilfe'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmHilfe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdSchliessen_Click()
DoCmd.Close
End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Dies ist eine ganz allgemeine Prozedur zur Anzeige irgendwelcher
' Hilfe-Dateien. Der Name der konkret zu ffnenden Datei wird
' mit dem Parameter OpenArgs bergeben (siehe in der aufrufenden
' Prozedur)

If errorhandling Then On Error GoTo fehlerbehandlung

Dim fso As Object
Dim f As Object
Dim ts As Object
Dim lngFiletype As Long

If IsNull(Me.OpenArgs) Then Exit Sub

' Der zweite Parameter der Funktion OpenAsTextStream hngt vom Format
' der zu ffnenden Datei ab.

' Der Wert der Konstanten "Accessversion" wird so gesetzt:
' In VBA: Extras / Eigenschaften von ...
' Dort unter "Argumente fr die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so mssen sie durch Doppelpunkte voneinander getrennt werden!

Select Case Right(Me.OpenArgs, 3)
   Case "txt"                         ' Access 2000/2003
      lngFiletype = 0
      #If Accessversion > 2003 Then
         txtHilfetext.TextFormat = acTextFormatPlain
      #End If
   Case "rtf"                         ' Access 2007/2010
      lngFiletype = -1
      #If Accessversion > 2003 Then
         txtHilfetext.TextFormat = acTextFormatHTMLRichText
      #End If
   Case Else
      MsgBox "Unbekannter Dateityp der Hilfedatei!"
      Exit Sub
End Select

' Hilfedatei ffnen und anzeigen

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Me.OpenArgs)
Set ts = f.OpenAsTextStream(1, lngFiletype)

Me.txtHilfetext = ts.ReadAll
'Me!txtHilfetext.Locked = True
cmdSchliessen.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmErsterStart'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmErsterStart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

Private Sub cmdSchliessen_Click()

Select Case chkAnzeigen
Case 0   ' Formular anzeigen
   
   CurrentDb.Execute "UPDATE tblDBINFO SET dbi_wert='ja' WHERE dbi_name='erster_start'"

Case -1   ' Formular NICHT anzeigen
   
   CurrentDb.Execute "UPDATE tblDBINFO SET dbi_wert='nein' WHERE dbi_name='erster_start'"

End Select

DoCmd.Close
End Sub

Private Sub Form_Open(Cancel As Integer)

If DLookup("dbi_wert", "tblDBINFO", "dbi_name='erster_start'") = "nein" Then
   Cancel = True
End If

End Sub

========================================================
Code of the form 'frmMannschaften_ufoMitglieder'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMannschaften_ufoMitglieder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub txtName_Click()
'--------------------------------------------------------------
'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

If errorhandling Then On Error GoTo fehlerbehandlung

Forms!frmMannschaften.Controls!cmdRueber.Enabled = False
Forms!frmMannschaften.Controls!cmdZurueck.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_DblClick(Cancel As Integer)
'--------------------------------------------------------------
'ffnen des Mitgliederformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMitglieder", , , , , , Me!mit_id

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtVorname_Click()
'--------------------------------------------------------------
'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

If errorhandling Then On Error GoTo fehlerbehandlung

Forms!frmMannschaften.Controls!cmdRueber.Enabled = False
Forms!frmMannschaften.Controls!cmdZurueck.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmTrainer'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTrainer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdDruckAlle_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenReport "rptTrainer", acViewPreview

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdDruckEinen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenReport "rptTrainer", acViewPreview, , "trainer_id = " & Me!lstTrainer

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Call HilfeAnzeigen("trainer")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim lngAntwort As Long
Dim strMsgtext As String


strMsgtext = "Wollen Sie " & Nz(Me!txtVorname, " ") & " " & Me!txtName & _
          " wirklich lschen?" & vbCrLf & _
          "ACHTUNG:" & vbCrLf & _
          "Dann wird er/sie auch bei allen Mitgliedern, Mannschaften und " & vbCrLf & _
          "Trainingszeiten, denen er/sie bisher zugeordnet ist, entfernt !"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

CurrentDb.Execute "UPDATE tblMitglied SET trainer_id_f=NULL WHERE trainer_id_f=" & Str(Me!trainer_id)
CurrentDb.Execute "UPDATE tblMannschaft SET trainer_id_f=NULL WHERE trainer_id_f=" & Str(Me!trainer_id)
CurrentDb.Execute "UPDATE tblTraining SET trainer_id_f=NULL WHERE trainer_id_f=" & Str(Me!trainer_id)
CurrentDb.Execute "DELETE FROM tblTrainer WHERE trainer_id=" & Str(Me!trainer_id)

lstTrainer.Requery
lstTrainer.SetFocus
If Nz(lstTrainer.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstTrainer = Me!lstTrainer.ItemData(0)
   Call lstTrainer_AfterUpdate
End If
    
Me!frmTrainer_ufoMannschaften.Requery
Me!frmTrainer_ufoMitglieder.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim trainerkey As Long

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie einen Namen ein!"
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand (acCmdSaveRecord)
trainerkey = Me!trainer_id
lstTrainer.Enabled = True
lstTrainer.Requery

lstTrainer.SetFocus
lstTrainer = trainerkey
Call lstTrainer_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstTrainer = Null
lstTrainer.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstTrainer.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstTrainer.ListCount) > 0 Then   ' Anzeige der ersten Zeile
      Me!lstTrainer = Me!lstTrainer.ItemData(0)
      Call lstTrainer_AfterUpdate
   End If

Else

   Me!lstTrainer = OpenArgs
   Call lstTrainer_AfterUpdate

End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstTrainer_AfterUpdate()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstTrainer) Then Me.Recordset.FindFirst "trainer_id=" & Me!lstTrainer

Me!frmTrainer_ufoMannschaften.Requery
Me!frmTrainer_ufoMitglieder.Requery

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie einen Namen ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmMannschaften'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMannschaften"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboTrainer_DblClick(Cancel As Integer)
'--------------------------------------------------------------
' Wechsel zum Trainer-Formular

If errorhandling Then On Error GoTo fehlerbehandlung

' Der Nutzer knnte den Namen des Trainers lschen und dann - OHNE zu speichern -
' einen Doppelklick machen. Dann wrde sich trotzdem das Trainerformular ffnen;
' es wrde dann aber beim Schlieen des Trainerformulars ein Laufzeitfehler kommen!

DoCmd.RunCommand (acCmdSaveRecord)

If Not IsNull(cboTrainer) Then _
   DoCmd.OpenForm "frmTrainer", , , , , , Me!cboTrainer
   
Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical
   
End Sub

Private Sub cboTrainer_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

If errorhandling Then On Error GoTo fehlerbehandlung

cboTrainer.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical


End Sub

Private Sub cmdDruckAlle_Click()
'--------------------------------------------------------------
' Alle Mannschaften drucken

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenReport "rptMannschaften", acViewPreview

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdDruckEinen_Click()
'--------------------------------------------------------------
' Eine Mannschaft drucken

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenReport "rptMannschaften", acViewPreview, , "man_id = " & Me!man_id

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
'--------------------------------------------------------------
' Hilfe anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

Call HilfeAnzeigen("mannschaften")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdRueber_Click()
'--------------------------------------------------------------
'Mitglied zuordnen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

' Wenn der Nutzer den Button "Datensatz hinzufgen" drckt, Mannschaftsdaten eingibt
' und dann Mitglieder zuweisen will, so geht das nicht, weil sich die neue
' Mannschaft noch nicht in der Tabelle tblMannschaft befindet, d.h. sie hat noch keinen Wert
' fr man_id. Dann kann auch kein Eintrag in die Tabelle tblMitglied erfolgen.
' Daher muss die neue Mannschaft erst einmal gespeichert werden.

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie einen Mannschaftsnamen ein!"
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lstMannschaften.Requery

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If IsNull(Me!lstMitglieder) Then
   MsgBox "Bitte ein Mitglied in der rechten Liste auswhlen!"
   Exit Sub
End If

'Mitglied einer Mannschaft zuordnen

Set rs = CurrentDb.OpenRecordset("tblMitglied", dbOpenDynaset)

rs.FindFirst "mit_id=" & Me!lstMitglieder
If rs.NoMatch Then Exit Sub
rs.Edit
rs!man_id_f = Me!man_id
rs.Update
rs.Close
Set rs = Nothing

lstMitglieder.Requery
Me!frmMannschaften_ufoMitglieder.Requery
Me!frmMannschaften_ufoMitglieder.Controls!txtName.SetFocus


Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdTrainer_Click()
'--------------------------------------------------------------
' Trainerzuweisung aufheben

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboTrainer) Then Exit Sub

If MsgBox("Wollen Sie die Zuweisung eines Trainers wirklich aufheben ?", _
          vbYesNo + vbDefaultButton2) = vbYes Then
   cboTrainer = Null
   Call cmdSpeichern_Click
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZurueck_Click()
'--------------------------------------------------------------
' Mitglied aus Mannschaft entfernen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("tblMitglied", dbOpenDynaset)

If IsNull(Me!frmMannschaften_ufoMitglieder!mit_id) Then Exit Sub

rs.FindFirst "mit_id=" & Str(Me!frmMannschaften_ufoMitglieder!mit_id)
If rs.NoMatch Then Exit Sub
rs.Edit
rs!man_id_f = Null
rs.Update
rs.Close
Set rs = Nothing

lstMitglieder.Requery
Me!frmMannschaften_ufoMitglieder.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Eine Mannschaft lschen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset
Dim lngAntwort As Long
Dim strMsgtext As String

'Sicherheitsabfrage

strMsgtext = "Wollen Sie die Mannschaft " & Me!txtName & " wirklich lschen?" & vbCrLf & _
          "ACHTUNG:" & vbCrLf & _
          "Dann werden auch alle Wettkampf-Teilnahmen dieser Mannschaft gelscht!"

' Gibt es noch Mitglieder in der zu lschenden Mannschaft?

Set rs = CurrentDb.OpenRecordset("tblMitglied", dbOpenDynaset)
rs.FindFirst "man_id_f=" & Str(Me!man_id)

If rs.NoMatch Then
'Wenn nicht, dann lschen
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   rs.Close
   Set rs = Nothing
   If lngAntwort = vbNo Then Exit Sub
   CurrentDb.Execute "DELETE FROM tblMan_Wet WHERE man_id_f=" & Str(Me!man_id)
   CurrentDb.Execute "DELETE FROM tblMannschaft WHERE man_id=" & Str(Me!man_id)
   lstMannschaften.Requery
   lstMannschaften.SetFocus
   If Nz(lstMannschaften.ListCount) > 0 Then   ' Anzeige der ersten Zeile
      Me!lstMannschaften = Me!lstMannschaften.ItemData(0)
      Call lstMannschaften_AfterUpdate
   End If
Else
   MsgBox "Bitte entfernen Sie erst alle Mitglieder aus dieser Mannschaft!"
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim mankey As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie einen Namen ein !"
   txtName.SetFocus
   Exit Sub
End If

'Speichern

DoCmd.RunCommand acCmdSaveRecord
mankey = Me!man_id
lstMannschaften.Enabled = True
lstMannschaften.Requery

lstMannschaften.SetFocus
lstMannschaften = mankey
Call lstMannschaften_AfterUpdate

cboTrainer.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus
cboTrainer.Requery

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstMannschaften = Null
lstMannschaften.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainer_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboTrainer_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboTrainer.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Trainer wirklich ndern?", _
           vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical


End Sub

Private Sub Form_Activate()
' Wenn jemand das Mitgliederformular mit einem Doppelclick auf die Mitgliederliste
' in diesem Formular ffnet und dann im Mitgliederformular ein neues Mitglied
' anlegt oder ein Mitglied lscht, muss die Liste hier aktualisiert werden.

Me!lstMitglieder.Requery

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

'Abwechselnde Aktivierung der beiden Buttons cmdRueber und cmdZurueck
cmdRueber.Enabled = False
cmdZurueck.Enabled = False

' Wenn das Formular mittels Doppelklick von einem anderen Formular aus
' geffnet wird, soll der dort angeklickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.
Me!lstMannschaften.SetFocus

If IsNull(OpenArgs) Then
   If Nz(lstMannschaften.ListCount) > 0 Then
      Me!lstMannschaften = Me!lstMannschaften.ItemData(0)
      Call lstMannschaften_AfterUpdate
   End If
Else
   Me!lstMannschaften = OpenArgs
   Call lstMannschaften_AfterUpdate
End If
cmdLoeschen.Enabled = True
cmdNeu.Enabled = True
Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMannschaften_AfterUpdate()
'--------------------------------------------------------------
'Die Daten des in der Liste angeklickten Datensatzes anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstMannschaften) Then Me.Recordset.FindFirst "man_id=" & Me!lstMannschaften

cmdRueber.Enabled = False
cmdZurueck.Enabled = False

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitglieder_Click()
'--------------------------------------------------------------
'Abwechselnde Aktivierung der beiden Buttons "rueber" und "zurck"

If errorhandling Then On Error GoTo fehlerbehandlung

cmdRueber.Enabled = True
cmdZurueck.Enabled = False

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitglieder_DblClick(Cancel As Integer)
'--------------------------------------------------------------
' Wechsel zum Mitglieder-Formular

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMitglieder", , , , , , Me!lstMitglieder

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical


End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!


If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie einen Mannschaftsnamen ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical


End Sub

========================================================
Code of the form 'frmMWettkaempfe_ufoMannschaften'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMWettkaempfe_ufoMannschaften"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub txtName_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Forms!frmMWettkaempfe!cmdRueber.Enabled = False
Forms!frmMWettkaempfe!cmdZurueck.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_DblClick(Cancel As Integer)
'--------------------------------------------------------------
' Wechsel zum Mannschaften-Formular

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMannschaften", , , , , , Me!man_id

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmSpaltenFuellen'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmSpaltenFuellen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Alle notwendigen Erluterungen befinden sich direkt auf dem Formular!

If errorhandling Then On Error GoTo fehlerbehandlung


Dim lngZeile As Long
Dim lngAnzahlZeilen As Long
Dim strSQL As String
Dim rs As DAO.Recordset
Dim tdef As TableDef
Dim blnGefunden As Boolean
Dim tabspalte As Field

lblFertig.Visible = False

If Nz(txtInTabelle) = "" Then
   MsgBox "Bitte geben Sie den Namen der Zieltabelle ein!"
   txtInTabelle.SetFocus
   Exit Sub
End If

If Nz(txtInSpalte) = "" Then
   MsgBox "Bitte geben Sie den Namen der Zielspalte ein!"
   txtInSpalte.SetFocus
   Exit Sub
End If

' Existiert die Zieltabelle?

blnGefunden = False
For Each tdef In CurrentDb.TableDefs
   If tdef.Name = txtInTabelle Then
      blnGefunden = True
      Exit For
   End If
Next tdef

If Not blnGefunden Then
   MsgBox "Es gibt keine Tabelle mit dem Namen " & txtInTabelle & "!"
   DoCmd.Hourglass False
   txtInTabelle.SetFocus
   Exit Sub
End If

' Existiert die Zielspalte?

blnGefunden = False
For Each tabspalte In tdef.Fields
   If tabspalte.Name = txtInSpalte Then blnGefunden = True
Next tabspalte

If Not blnGefunden Then
   MsgBox "Es gibt in der Tabelle " & txtInTabelle & _
          " keine Spalte mit dem Namen " & txtInSpalte & "!"
   DoCmd.Hourglass False
   txtInSpalte.SetFocus
   Exit Sub
End If

' Das knnte lange dauern - darum Anzeige der Sanduhr

DoCmd.Hourglass True

' Wieviele Zeilen hat die Tabelle tblFuelltext?

lngAnzahlZeilen = Nz(DCount("fuell_id", "tblFuelltext"))

If lngAnzahlZeilen = 0 Then
   MsgBox "Die Tabelle tblFuelltext ist leer!"
   Exit Sub
End If

' Nummer der Zeile der Tabelle tblFuelltext, in der begonnen werden soll
' (standardmig die erste - man kann aber auch irgendwo anders beginnen)

lngZeile = DMin("fuell_id", "tblFuelltext")
'lngZeile = 99

' Trick17: Die Spalte, in die die Daten HINEIN sollen, bekommt
' den Aliasnamen "fuellspalte". Darum braucht man sich nachher beim Fllen
' nicht mehr um den konkreten Namen der Spalte zu kmmern und kann
' einfach schreiben "rs!fuellspalte"

strSQL = "SELECT " & txtInSpalte & " AS fuellspalte FROM " & txtInTabelle

' Jeweils EINEN Flltext in jede zu fllende Zelle

Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rs.EOF
   rs.Edit
   rs!fuellspalte = DLookup("fuell_text", "tblFuelltext", "fuell_id=" & Str(lngZeile))
   rs.Update
   lngZeile = lngZeile + 1   ' nchste Zeile in tblFuelltext
   If lngZeile > lngAnzahlZeilen Then lngZeile = 1   ' ggf. von vorne beginnen
   rs.MoveNext
Loop

' Jeweils ZWEI Flltexte in jede zu fllende Zelle

'Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
'Do Until rs.EOF
'   rs.Edit
'   rs!fuellspalte = DLookup("fuell_text", "tblFuelltext", "fuell_id=" & Str(lngZeile))
'   lngZeile = lngZeile + 1   ' nchste Zeile in tblFuelltext
'   If lngZeile > lngAnzahlZeilen Then lngZeile = 1   ' ggf. von vorne beginnen
'   rs!fuellspalte = rs!fuellspalte & " " & _
'                    DLookup("fuell_text", "tblFuelltext", "fuell_id=" & Str(lngZeile))
'   rs.Update
'   lngZeile = lngZeile + 1   ' nchste Zeile in tblFuelltext
'   If lngZeile > lngAnzahlZeilen Then lngZeile = 1   ' ggf. von vorne beginnen
'   rs.MoveNext
'Loop


rs.Close
Set rs = Nothing

DoCmd.Hourglass False
lblFertig.Visible = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
txtInTabelle.SetFocus
lblFertig.Visible = False
End Sub

Private Sub txtInSpalte_Change()
'--------------------------------------------------------------
lblFertig.Visible = False
End Sub

Private Sub txtInTabelle_Change()
'--------------------------------------------------------------
lblFertig.Visible = False
End Sub

Private Sub txtVonSpalte_Change()
'--------------------------------------------------------------
lblFertig.Visible = False
End Sub

Private Sub txtVonTabelle_Change()
'--------------------------------------------------------------
lblFertig.Visible = False
End Sub

========================================================
Code of the form 'frmTrainer_ufoMannschaften'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTrainer_ufoMannschaften"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub button_entfernen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strMsgtext As String
Dim lngAntwort As Long

strMsgtext = "Wollen Sie die Zuordnung wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

CurrentDb.Execute "UPDATE tblMannschaft SET trainer_id_f=NULL WHERE man_id=" & Str(Me!man_id)
Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtName_DblClick(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMannschaften", , , , , , Me!man_id

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmStart'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmStart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdMitglieder_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMitglieder"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdMannschaften_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMannschaften"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdTrainer_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmTrainer"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdTraining_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmTraining"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdEWettkaempfe_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmEWettkaempfe"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdMWettkaempfe_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmMWettkaempfe"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
'Anzeige der Versionsnummer

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("tblDBINFO", dbOpenDynaset)
rs.FindFirst "dbi_name='version'"

If rs.NoMatch Then
  Me!lblVersion.Caption = ""
Else
  Me!lblVersion.Caption = rs!dbi_wert
End If

rs.Close
Set rs = Nothing

'Application.LoadCustomUI "Eigene_MFL", DLookup("mfl_code", "tblMFL", "mfl_name='eigene_MFL'")
''MsgBox DLookup("mfl_code", "tblMFL", "mfl_name='eigene_MFL'")
'Me.RibbonName = "Eigene_MFL"


Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdBeitragssaetze_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmBeitragssaetze"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdDatentypen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmTypen"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdPlaetze_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmPlaetze"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdBeenden_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

If MsgBox("Wollen Sie die Arbeit wirklich beenden und MS-Access schlieen?", vbYesNo + vbDefaultButton2) = vbYes Then DoCmd.Quit

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmMitglieder'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMitglieder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboMannschaft_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboTrainer_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

Private Sub cboTrainer_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

cboTrainer.Requery

End Sub

Private Sub cmdDruckAlle_Click()
'--------------------------------------------------------------
DoCmd.OpenReport "rptMitglieder", acViewPreview
End Sub

Private Sub cmdDruckEinen_Click()
'--------------------------------------------------------------
DoCmd.OpenReport "rptMitglieder", acViewPreview, , "mit_id = " & Me!lstMitglieder
End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
'--------------------------------------------------------------
Call HilfeAnzeigen("mitglieder")
End Sub

Private Sub cmdMannschaft_Click()
'--------------------------------------------------------------
' Zuordnung zu einer Mannschaft aufheben
' ACHTUNG:
' Nach dem Lschen wird im Formular der erste Datensatz angezeigt,
' weil ein requery erforderlich ist und dadurch wird zum ersten
' Datensatz gesprungen.
' Um den gerade bearbeiteten Datensatz anzuzeigen, mu mittels
' Bookmark dorthin zurckgesprungen werden.

Dim varBookmark As Variant

If errorhandling Then On Error GoTo fehlerbehandlung

'Wenn keine Mannschaft zugeordnet wurde, kann auch keine gelscht werden

If IsNull(cboMannschaft) Then Exit Sub

If MsgBox("Wollen Sie die Zuweisung einer Mannschaft wirklich aufheben ?", _
           vbYesNo + vbDefaultButton2) = vbYes Then
   CurrentDb.Execute "UPDATE tblMitglied SET man_id_f=NULL WHERE mit_id=" & Str(Me!mit_id)
   varBookmark = Me.Bookmark
   Requery
   Me.Bookmark = varBookmark
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdTrainer_Click()
'--------------------------------------------------------------
' Zuordnung eines Trainers aufheben
' ACHTUNG:
' Nach dem Lschen wird im Formular der erste Datensatz angezeigt,
' weil ein requery erforderlich ist und dadurch wird zum ersten
' Datensatz gesprungen.
' Um den gerade bearbeiteten Datensatz anzuzeigen, mu mittels
' Bookmark dorthin zurckgesprungen werden.

Dim varBookmark As Variant

If errorhandling Then On Error GoTo fehlerbehandlung

'Wenn kein Trainer zugeordnet wurde, kann auch keiner gelscht werden

If IsNull(cboTrainer) Then Exit Sub

If MsgBox("Wollen Sie die Zuweisung eines Trainers wirklich aufheben ?", _
                     vbYesNo + vbDefaultButton2) = vbYes Then
   CurrentDb.Execute "UPDATE tblMitglied SET trainer_id_f=NULL WHERE mit_id=" & _
                      Str(Me!mit_id)
   varBookmark = Me.Bookmark
   Requery
   Me.Bookmark = varBookmark
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboMannschaft_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If IsNull(cboMannschaft.OldValue) Then Exit Sub
If MsgBox("Wollen Sie die Mannschaft wirklich ndern?", _
          vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If
End Sub

Private Sub cboTrainer_DblClick(Cancel As Integer)
'--------------------------------------------------------------
'ffnen des Trainerformulars

If errorhandling Then On Error GoTo fehlerbehandlung

' Der Nutzer knnte den Namen des Trainers lschen und dann - OHNE zu speichern -
' einen Doppelklick machen. Dann wrde sich trotzdem das Trainerformular ffnen;
' es wrde dann aber beim Schlieen des Trainerformulars ein Laufzeitfehler kommen!

DoCmd.RunCommand (acCmdSaveRecord)

If Not IsNull(cboTrainer) Then _
   DoCmd.OpenForm "frmTrainer", , , , , , Me!cboTrainer

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainer_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If IsNull(cboTrainer.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Trainer wirklich ndern?", _
          vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If
End Sub

Private Sub cboTrainer_KeyDown(KeyCode As Integer, Shift As Integer)
'--------------------------------------------------------------
'Aufheben der Trainerzuweisung mit der "Entf."-Taste

Dim strSQL As String
Dim varBookmark As Variant
Dim strMsgtext As String
Dim lngAntwort As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'Wenn kein Trainer zugeordnet wurde, kann auch keiner gelscht werden

If IsNull(cboTrainer) Then Exit Sub

'Es soll nur auf die "Entf."-Taste reagiert werden

If KeyCode <> vbKeyDelete Then Exit Sub

'Sicherheitsabfrage

strMsgtext = "Wollen Sie die Zuweisung eines Trainers wirklich aufheben ?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

strSQL = "UPDATE tblMitglied SET trainer_id_f=NULL WHERE mit_id=" & Str(Me!mit_id)
varBookmark = Me.Bookmark

CurrentDb.Execute (strSQL)
Requery

Me.Bookmark = varBookmark

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_AfterUpdate()
'--------------------------------------------------------------
' Wenn der angezeigte Datensatz gendert wurde, muss die Liste aktualisiert werden

Me!lstMitglieder.Requery

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstMitglieder.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstMitglieder.ListCount) > 0 Then   ' Anzeige der ersten Zeile
      Me!lstMitglieder = Me!lstMitglieder.ItemData(0)
      Call lstMitglieder_AfterUpdate
   End If

Else
   
   Me!lstMitglieder = OpenArgs
   Call lstMitglieder_AfterUpdate
   
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboMannschaft_DblClick(Cancel As Integer)
'--------------------------------------------------------------
'ffnen des Mannschaftenformulars

If errorhandling Then On Error GoTo fehlerbehandlung

' Der Nutzer knnte den Namen der Mannschaft lschen und dann - OHNE zu speichern -
' einen Doppelklick machen. Dann wrde sich trotzdem das Mannschaftsformular ffnen;
' es wrde dann aber beim Schlieen des Mannschaftsformulars ein Laufzeitfehler kommen!

DoCmd.RunCommand (acCmdSaveRecord)

If Not IsNull(cboMannschaft) Then _
   DoCmd.OpenForm "frmMannschaften", , , , , , Me!cboMannschaft

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboMannschaft_KeyDown(KeyCode As Integer, Shift As Integer)
'--------------------------------------------------------------
'Aufheben der Mannschaftszuweisung mit der "Entf."-Taste

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strSQL As String
Dim varBookmark As Variant
Dim lngAntwort As Long

'Wenn keine Mannschaft zugeordnet wurde, kann auch keine gelscht werden

If IsNull(cboMannschaft) Then Exit Sub

'Es soll nur auf die "Entf."-Taste reagiert werden

If KeyCode <> vbKeyDelete Then Exit Sub

lngAntwort = MsgBox("Wollen Sie die Zuweisung einer Mannschaft wirklich aufheben ?", vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

strSQL = "UPDATE tblMitglied SET man_id_f=NULL WHERE mit_id=" & Str(Me!mit_id)
varBookmark = Me.Bookmark

CurrentDb.Execute (strSQL)
Requery

Me.Bookmark = varBookmark

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitglieder_AfterUpdate()
'--------------------------------------------------------------
'Die Daten des in der Liste angeclickten Datensatzes anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstMitglieder) Then Me.Recordset.FindFirst "mit_id=" & Me!lstMitglieder

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Ein Mitglied lschen

If errorhandling Then On Error GoTo fehlerbehandlung

Dim lngAntwort As Long
Dim strMsgtext As String

'Sicherheitsabfrage

strMsgtext = "Wollen Sie das Mitglied " & Me!txtMitVorname & " " & Me!txtName & _
          " wirklich lschen?" & vbCrLf & _
          "ACHTUNG:" & vbCrLf & _
          "Dann werden auch alle Beitrge, Mitgliedschaften, Trainingszeiten " & vbCrLf & _
          "und Wettkampf-Teilnahmen dieses Mitglieds gelscht!"
          
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

'Lschen

CurrentDb.Execute "DELETE FROM tblMitgliedschaft WHERE mit_id_f=" & Str(Me!mit_id)
CurrentDb.Execute "DELETE FROM tblMit_Training WHERE mit_id_f=" & Str(Me!mit_id)
CurrentDb.Execute "DELETE FROM tblTraining WHERE mit_id_f=" & Str(Me!mit_id)
CurrentDb.Execute "DELETE FROM tblMit_Wet WHERE mit_id_f=" & Str(Me!mit_id)
CurrentDb.Execute "DELETE FROM tblMitglied WHERE mit_id=" & Str(Me!mit_id)

lstMitglieder.Requery
lstMitglieder.SetFocus
If Nz(lstMitglieder.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstMitglieder = Me!lstMitglieder.ItemData(0)
   Call lstMitglieder_AfterUpdate
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngMitId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If Nz(txtName) = "" Then
   MsgBox "Bitte geben Sie einen Namen ein !"
   txtName.SetFocus
   Exit Sub
End If

'Speichern

DoCmd.RunCommand acCmdSaveRecord
lngMitId = Me!mit_id
lstMitglieder.Enabled = True
lstMitglieder.Requery
    
lstMitglieder.SetFocus
lstMitglieder = lngMitId
Call lstMitglieder_AfterUpdate
    
cboTrainer.Requery
cboMannschaft.Requery
frmMitglieder_ufoMitgliedschaften.Controls!cboMitgliedstyp.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
'Ein neues Mitglied anlegen

If errorhandling Then On Error GoTo fehlerbehandlung


'Wenn dieses Formular geffnet ist und gleichzeitig neue Trainer,
'Mannschaften oder Mitgliedstypen angelegt werden, so erscheinen
'diese nicht in den entsprechenden Comboboxen. Fr diese muss daher
'ein Requery ausgefhrt werden

cboTrainer.Requery
cboMannschaft.Requery
frmMitglieder_ufoMitgliedschaften.Controls!cboMitgliedstyp.Requery

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstMitglieder = Null
lstMitglieder.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdBeitraege_Click()
'--------------------------------------------------------------
'ffnen des Formulars "Beitragsstze"

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmBeitragssaetze"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical
  
End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte geben Sie einen Namen ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical
  
End Sub

========================================================
Code of the form 'frmMitglieder_ufoMitgliedschaften'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMitglieder_ufoMitgliedschaften"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboMitgliedstyp_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.

If IsNull(cboMitgliedstyp.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Typ wirklich ndern?", _
          vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If

End Sub

Private Sub cboMitgliedstyp_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

cboMitgliedstyp.Requery

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Eine Mitgliedschaft lschen

If errorhandling Then On Error GoTo fehlerbehandlung

'In der letzten Zeile kann ein neuer Datensatz eingefgt werden.
'Diese Zeile darf und kann nicht gelscht werden.

If IsNull(Me!mschaft_id) Then Exit Sub
  
'Sicherheitsabfrage

If MsgBox("Wollen Sie die Mitgliedschaft wirklich lschen ?", _
           vbYesNo + vbDefaultButton2, "Lschabfrage") = vbYes Then
   CurrentDb.Execute "DELETE FROM tblMitgliedschaft WHERE mschaft_id=" & _
                      Str(Me!mschaft_id)
   Requery
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Wurden alle erforderlichen Daten eingegeben?

If IsNull(cboVonMonat) Then
   MsgBox "Bitte geben Sie einen von-Monat ein oder" & vbCrLf & _
          "drcken Sie die Esc-Taste fr einen Abbruch der Dateneingabe!"
   Cancel = True
   cboVonMonat.SetFocus
   Exit Sub
End If

If Nz(txtVonJahr) = "" Then
   MsgBox "Bitte geben Sie ein von-Jahr ein oder" & vbCrLf & _
          "drcken Sie die Esc-Taste fr einen Abbruch der Dateneingabe!"
   Cancel = True
   txtVonJahr.SetFocus
   Exit Sub
End If

If Not IsNumeric(txtVonJahr) Or txtVonJahr < 1900 Or txtVonJahr > 2100 Then
   MsgBox "Bitte geben Sie einen gltigen Wert fr das von-Jahr ein!"
   Cancel = True
   txtVonJahr.SetFocus
   Exit Sub
End If

End Sub

Private Sub Form_LostFocus()
DoCmd.RunCommand acCmdSaveRecord
End Sub

========================================================
Code of the form 'frmTypen'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTypen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
Call HilfeAnzeigen("datentypen")
End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmMitglieder_ufoBeitraege'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmMitglieder_ufoBeitraege"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Einen Beitrag lschen

If errorhandling Then On Error GoTo fehlerbehandlung

'In der letzten Zeile kann ein neuer Datensatz eingefgt werden.
'Diese Zeile darf und kann nicht gelscht werden.

If IsNull(Me!bei_id) Then Exit Sub

'Sicherheitsabfrage

If MsgBox("Wollen Sie den Beitrag wirklich lschen ?", _
           vbYesNo + vbDefaultButton2, "Lschabfrage") = vbYes Then
    CurrentDb.Execute "DELETE FROM tblBeitrag WHERE bei_id=" & Str(Me!bei_id)
    Requery
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------
' Wurden alle erforderlichen Daten eingegeben?

If errorhandling Then On Error GoTo fehlerbehandlung


If IsNull(cboVonMonat) Then
   MsgBox "Bitte geben Sie einen von-Monat ein oder" & vbCrLf & _
          "drcken Sie die Esc-Taste fr einen Abbruch der Dateneingabe!"
   Cancel = True
   cboVonMonat.SetFocus
   Exit Sub
End If

If Nz(txtVonJahr) = "" Then
   MsgBox "Bitte geben Sie ein von-Jahr ein oder" & vbCrLf & _
          "drcken Sie die Esc-Taste fr einen Abbruch der Dateneingabe!"
   Cancel = True
   txtVonJahr.SetFocus
   Exit Sub
End If

If Not IsNumeric(txtVonJahr) Or txtVonJahr < 1900 Or txtVonJahr > 2100 Then
   MsgBox "Bitte geben Sie einen gltigen Wert fr das von-Jahr ein!"
   Cancel = True
   txtVonJahr.SetFocus
   Exit Sub
End If

If Nz(txtBeitrag) = "" Then
   MsgBox "Bitte geben Sie einen Betrag ein oder" & vbCrLf & _
          "drcken Sie die Esc-Taste fr einen Abbruch der Dateneingabe!"
   Cancel = True
   txtBeitrag.SetFocus
   Exit Sub
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_LostFocus()
DoCmd.RunCommand acCmdSaveRecord
End Sub


========================================================
Code of the form 'frmTraining'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTraining"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub cboPlatz_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboPlatz_BeforeUpdate(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboPlatz) Then
   MsgBox "Das Training muss auf einem Platz stattfinden!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboPlatz_DblClick(Cancel As Integer)
'--------------------------------------------------------------
' Wechsel zum Formular "Pltze"

If errorhandling Then On Error GoTo fehlerbehandlung

' Der Nutzer knnte den Namen des Platzes lschen und dann - OHNE zu speichern -
' einen Doppelklick machen. Dann wrde sich trotzdem das Platzformular ffnen;
' es wrde dann aber beim Schlieen des Platzformulars ein Laufzeitfehler kommen!

DoCmd.RunCommand (acCmdSaveRecord)

If Not IsNull(cboPlatz) Then _
   DoCmd.OpenForm "frmPlaetze", , , , , , Me!cboPlatz
   
Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboPlatz_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.
' (Bei der allerersten Eingabe eines Wertes wird nicht gefragt).

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboPlatz.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Platz wirklich ndern?", _
           vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboPlatz_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

If errorhandling Then On Error GoTo fehlerbehandlung

cboPlatz.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboPlatzFilter_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

If errorhandling Then On Error GoTo fehlerbehandlung

cboPlatzFilter.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainer_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboTrainer_DblClick(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

' Der Nutzer knnte den Namen des Trainers lschen und dann - OHNE zu speichern -
' einen Doppelklick machen. Dann wrde sich trotzdem das Trainerformular ffnen;
' es wrde dann aber beim Schlieen des Trainerformulars ein Laufzeitfehler kommen!

DoCmd.RunCommand (acCmdSaveRecord)

If Not IsNull(cboTrainer) Then _
   DoCmd.OpenForm "frmTrainer", , , , , , Me!cboTrainer

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainer_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.
' (Bei der allerersten Eingabe eines Wertes wird nicht gefragt).

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboTrainer.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Trainer wirklich ndern?", _
           vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If
           
Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainer_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

If errorhandling Then On Error GoTo fehlerbehandlung

cboTrainer.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainmitglied_AfterUpdate()
'--------------------------------------------------------------
' Durch die nderung des Wertes in einem Kombinationsfeld wird eine
' Transaktion (nderung von Daten in der Datenbank) begonnen
' (erkennbar am Schreibstift im Datensatzmarkierer!).
' Da eine nicht ordnungsgem beendete Transaktion zu Fehlern fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub cboTrainmitglied_DblClick(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

' Der Nutzer knnte den Namen des Mitglieds lschen und dann - OHNE zu speichern -
' einen Doppelklick machen. Dann wrde sich trotzdem das Mitgliederformular ffnen;
' es wrde dann aber beim Schlieen des Mitgliederformulars ein Laufzeitfehler kommen!

DoCmd.RunCommand (acCmdSaveRecord)

If Not IsNull(cboTrainmitglied) Then _
   DoCmd.OpenForm "frmMitglieder", , , , , , Me!cboTrainmitglied

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainmitglied_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Als Schutz gegen ein versehentliches ndern des Wertes im Kombinationsfeld
' wird gefragt, ob der Wert wirklich gendert werden soll.
' (Bei der allerersten Eingabe eines Wertes wird nicht gefragt).

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboTrainmitglied.OldValue) Then Exit Sub
If MsgBox("Wollen Sie das trainierende Mitglied wirklich ndern?", _
           vbYesNo + vbDefaultButton2) = vbNo Then
   Cancel = True       ' Abbruch der Bearbeitung
   SendKeys ("{ESC}")  ' Schlieen der Combobox
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboTrainmitglied_GotFocus()
'--------------------------------------------------------------
' Die Datenquelle des Kombinationsfeldes knnte in einem anderen Formular
' gendert worden sein (neuer Datensatz / gelschter Datensatz).
' Darum muss es VOR jeder Benutzung zunchst neu mit den jeweils
' aktuellen Daten gefllt werden.

If errorhandling Then On Error GoTo fehlerbehandlung

cboTrainmitglied.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdDatumMinus_Click()
'--------------------------------------------------------------
'Setze das Datum einen Tag zurck

If errorhandling Then On Error GoTo fehlerbehandlung

Me!training_datum = Me!training_datum - 1

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False
txtDatum.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdDatumPlus_Click()
'--------------------------------------------------------------
'Setze das Datum einen Tag vorwrts

If errorhandling Then On Error GoTo fehlerbehandlung

Me!txtDatum = Me!txtDatum + 1

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False
txtDatum.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
'Startformular anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm ("frmStart")

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdHilfe_Click()
Call HilfeAnzeigen("training")
End Sub

Private Sub cmdRueber_Click()
'--------------------------------------------------------------
'Fge ein Mitglied zu der Trainingszeit hinzu

Dim rs As DAO.Recordset

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(Me!lstMitglieder) Then
   MsgBox "Bitte ein Mitglied in der rechten Liste auswhlen!"
   Exit Sub
End If

If IsNull(Me!lstTrainings) Then
   MsgBox "Bitte eine Trainingszeit auswhlen!"
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMit_Training", dbOpenDynaset)

rs.FindFirst "mit_id_f=" & Str(Me!lstMitglieder) & " AND training_id_f=" & Str(Me!training_id)
If rs.NoMatch Then
   rs.AddNew
   rs!mit_id_f = Me!lstMitglieder
   rs!training_id_f = Me!training_id
   rs.Update
   lstMitglieder.Requery
   Me!frmTraining_ufoMitglieder.Requery
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdRueckgaengig_Click()
'--------------------------------------------------------------
'Alle nderungen in den Trainingsdaten rckgngig machen

If errorhandling Then On Error GoTo fehlerbehandlung

SendKeys "{ESC}"
lstTrainings.Locked = False
cboPlatzFilter.Locked = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdTrainerEntfernen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

cboTrainer = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdTrainmitgliedEntfernen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

cboTrainmitglied = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZeitBisMinus_Click()
'--------------------------------------------------------------
'Setze die Endezeit eine Viertelstunde zurck
'Eine Viertelstunde ist 1/96stel eines Tages
'Darum "- (1 / 96)"

If errorhandling Then On Error GoTo fehlerbehandlung

Me!txtZeitBis = Me!txtZeitBis - (1 / 96)

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False
txtZeitBis.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZeitBisPlus_Click()
'--------------------------------------------------------------
'Setze die Endezeit eine Viertelstunde vorwrts
'Eine Viertelstunde ist 1/96stel eines Tages
'Darum "+ (1 / 96)"

If errorhandling Then On Error GoTo fehlerbehandlung

Me!txtZeitBis = Me!txtZeitBis + (1 / 96)

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False
txtZeitBis.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZeitVonMinus_Click()
'--------------------------------------------------------------
'Setze die Anfangszeit eine Viertelstunde zurck
'Eine Viertelstunde ist 1/96stel eines Tages
'Darum "- (1 / 96)"

If errorhandling Then On Error GoTo fehlerbehandlung

Me!txtZeitVon = Me!txtZeitVon - (1 / 96)

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False
txtZeitVon.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZeitVonPlus_Click()
'--------------------------------------------------------------
'Setze die Anfangszeit eine Viertelstunde vorwrts
'Eine Viertelstunde ist 1/96stel eines Tages
'Darum "+ (1 / 96)"

If errorhandling Then On Error GoTo fehlerbehandlung

Me!txtZeitVon = Me!txtZeitVon + (1 / 96)

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False
txtZeitVon.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdZurueck_Click()
'--------------------------------------------------------------
'Entferne ein Mitglied aus der Liste der trainierenden Mitglieder

Dim rs As DAO.Recordset

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(Me!frmTraining_ufoMitglieder!mit_id_f) Then Exit Sub

If IsNull(Me!lstTrainings) Then
   MsgBox "Bitte eine Trainingszeit auswhlen!"
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblMit_Training", dbOpenDynaset)

rs.FindFirst "mit_id_f=" & Str(Me!frmTraining_ufoMitglieder!mit_id_f) & " AND training_id_f=" & Str(Me!training_id)
If rs.NoMatch Then Exit Sub
rs.Edit
rs.Delete
rs.Close
Set rs = Nothing

lstMitglieder.Requery
Me!frmTraining_ufoMitglieder.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cboPlatzFilter_AfterUpdate()
'--------------------------------------------------------------
' Filtern der Trainingszeiten
' (nur Anzeige fr einen bestimmten Platz)

Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

strSQL = "SELECT training_id, training_datum, training_zeitvon, " & _
         "training_zeitbis, pla_bezeichnung " & _
         "FROM tblTraining INNER JOIN tblPlatz " & _
         "ON tblTraining.pla_id_f = tblPlatz.pla_id " & _
         "WHERE tblPlatz.pla_id = " & Str(cboPlatzFilter) & _
         " ORDER BY training_datum desc, training_zeitvon asc"
'MsgBox strSQL
Me!lstTrainings.RowSourceType = "Table/Query"
Me!lstTrainings.RowSource = strSQL

' Nachdem im Kombinationsfeld ein Platz ausgewhlt wurde,
' soll die erste Trainingszeit auf dem ausgewhlten Platz angezeigt werden.

Me!lstTrainings.SetFocus
If Nz(lstTrainings.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstTrainings = Me!lstTrainings.ItemData(0)
   Call lstTrainings_AfterUpdate
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub Form_Activate()
' Wenn jemand das Mitgliederformular mit einem Doppelclick auf die Mitgliederliste
' in diesem Formular ffnet und dann im Mitgliederformular ein neues Mitglied
' anlegt oder ein Mitglied lscht, muss die Liste hier aktualisiert werden.

Me!lstMitglieder.Requery

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

cmdRueber.Enabled = False
cmdZurueck.Enabled = False

'Me!cboPlatzFilter.SetFocus

If Nz(cboPlatzFilter.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!cboPlatzFilter = Me!cboPlatzFilter.ItemData(0)
   Call cboPlatzFilter_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitglieder_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

cmdRueber.Enabled = True
cmdZurueck.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub lstMitglieder_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmMitglieder", , , , , , Me!lstMitglieder
End Sub

Private Sub lstTrainings_AfterUpdate()
'--------------------------------------------------------------
'Zeige die Daten der ausgewhlten Trainingszeit an

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstTrainings) Then Me.Recordset.FindFirst "training_id=" & Me!lstTrainings

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

cboPlatzFilter.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
Dim strMsgtext As String
Dim lngAntwort As Long
Dim zeitvon As String
Dim zeitbis As String

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(lstTrainings) Then Exit Sub

If Not IsNull(Me!training_zeitvon) Then
   zeitvon = " von " & Str(Me!training_zeitvon) & " Uhr"
Else
   zeitvon = ""
End If

If Not IsNull(Me!training_zeitbis) Then
   zeitbis = " bis " & Str(Me!training_zeitbis) & " Uhr"
Else
   zeitbis = ""
End If

strMsgtext = "Wollen Sie die Trainingszeit am " & Str(Me!training_datum) & zeitvon & zeitbis & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

CurrentDb.Execute "DELETE FROM tblMit_Training WHERE " & _
                  "training_id_f=" & Str(Me!training_id)
CurrentDb.Execute "DELETE FROM tblTraining WHERE " & _
                  "training_id=" & Str(Me!training_id)

Requery
Me!frmTraining_ufoMitglieder.Requery
lstTrainings.Requery

Me!lstTrainings.SetFocus
If Nz(lstTrainings.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstTrainings = Me!lstTrainings.ItemData(0)
   Call lstTrainings_AfterUpdate
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngTrainingId As Long

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboPlatz) Then
   MsgBox "Bitte whlen Sie einen Platz aus!"
   cboPlatz.SetFocus
   Exit Sub
End If

If Nz(Me!txtDatum) = "" Then
   MsgBox "Bitte ein Datum eingeben!"
   Me!txtDatum.SetFocus
   Exit Sub
End If

If Nz(Me!txtZeitVon) = "" Then
   MsgBox "Bitte eine Zeit (von) eingeben!"
   Me!txtZeitVon.SetFocus
   Exit Sub
End If

If Nz(Me!txtZeitBis) = "" Then
   MsgBox "Bitte eine Zeit (bis) eingeben!"
   Me!txtZeitBis.SetFocus
   Exit Sub
End If

If Me!txtZeitBis <= Me!txtZeitVon Then
   MsgBox "Die Anfangszeit mu vor der Endzeit liegen!"
   Exit Sub
End If

'Kann die eingegebene Trainingszeit gespeichert werden oder ist sie bereits vergeben?
' (Dieser Test ist z.Z. deaktiviert. Die Funktion "vergeben" liefert IMMER 0 zurck!)

Select Case vergeben(txtDatum, txtZeitVon, txtZeitBis, lstTrainings, cboPlatz, cboTrainer, cboTrainmitglied)
   Case 1
      MsgBox "Der Platz ist zu dieser Trainingszeit leider schon vergeben."
   Case 2
      MsgBox "Der Trainer ist zu dieser Trainingszeit leider schon vergeben."
   Case 3
      MsgBox "Das Mitglied ist zu dieser Trainingszeit leider schon vergeben."
   Case 0
      DoCmd.RunCommand (acCmdSaveRecord)
      lngTrainingId = Me!training_id
      
      lstTrainings.Enabled = True
      lstTrainings.Requery
      lstTrainings.SetFocus
      lstTrainings = lngTrainingId
      Call lstTrainings_AfterUpdate

      cboPlatzFilter.Enabled = True
   Case Else
      MsgBox "Fehler in cmdSpeichern_Click()"
End Select

' Jetzt knnen weitere Eingaben erfolgen!

cboPlatz.Enabled = True
cboTrainer.Enabled = True
cboTrainmitglied.Enabled = True
lstMitglieder.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtDatum.SetFocus
txtDatum.Value = Date
txtZeitVon = TimeValue(Trim(Str(Hour(Time) + 1)) & ":00:00")
txtZeitBis = TimeValue(Trim(Str(Hour(Time) + 2)) & ":00:00")
cboPlatz = cboPlatzFilter

'Wenn ein neues Training angelegt werden soll, darf in der
'Trainingsliste keine Zeile ausgewhlt sein, sonst denkt
'die berprfungsroutine "vergeben()", dass kein neues
'Training angelegt, sondern ein vorhandenes gendert werden soll.

lstTrainings = Null

'Durch einen Click in die Trainingsliste knnte eine unzulssige (d.h.
'bereits anderweitig vergebene) Trainingszeit gespeichert werden.
'Die Trainingsliste wird erst nach erfolgreicher berprfung der
'Trainingszeit in der Prozedur cmdSpeichern_Click() wieder
'freigegeben.

lstTrainings.Enabled = False
cboPlatzFilter.Enabled = False

' Die Trainingszeit muss erst gespeichert werden, bevor Trainer
' und Mitglieder zugewiesen werden knnen.

cboPlatz.Enabled = False
cboTrainer.Enabled = False
cboTrainmitglied.Enabled = False
lstMitglieder.Enabled = False


cmdLoeschen.Enabled = False
cmdNeu.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub


========================================================
Code of the form 'frmExecSQL'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmExecSQL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit


Private Sub cmdLoeschen_Click()
txtSqlbefehl.Value = ""
txtSqlbefehl.SetFocus
End Sub

Private Sub cmdAusfuehren_Click()
On Error GoTo fehler

If txtSqlbefehl <> "" Then

   DoCmd.RunSQL txtSqlbefehl.Value
   MsgBox "Befehl erfolgreich ausgefhrt." & vbCrLf & _
          "Bitte kontrollieren Sie die Wirkung in der Datenbank!", _
          vbOKOnly + vbInformation

End If

Exit Sub
fehler:
    MsgBox "Bei der Ausfhrung des SQL-Befehls" & vbCrLf & vbCrLf & _
           txtSqlbefehl & vbCrLf & vbCrLf & _
           "trat der Fehler Nr. " & Err.Number & " auf: " & vbCrLf & vbCrLf & _
           Err.Description, vbOKOnly + vbExclamation
    txtSqlbefehl.SetFocus
    
End Sub


========================================================
Code of the form 'frmTypen_ufoPlatztyp'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmTypen_ufoPlatztyp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Database

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

cmdNeu.Enabled = True
cmdLoeschen.Enabled = True

Me!lstPlatztypen.SetFocus
If Nz(lstPlatztypen.ListCount) > 0 Then   ' Anzeige der ersten Zeile
   Me!lstPlatztypen = Me!lstPlatztypen.ItemData(0)
   Call lstPlatztypen_AfterUpdate
End If

Me.Cycle = 1

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.GoToRecord , , acNewRec
txtPlatztyp.SetFocus

cmdNeu.Enabled = False
cmdLoeschen.Enabled = False
lstPlatztypen = Null
lstPlatztypen.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngPtypId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

If Nz(txtPlatztyp) = "" Then
   MsgBox "Bitte geben Sie einen Platztyp ein!"
   txtPlatztyp.SetFocus
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblPlatztyp", dbOpenDynaset)
rs.FindFirst "ptyp_bezeichnung=" & "'" & Me!txtPlatztyp & "'"

If rs.NoMatch Then
   DoCmd.RunCommand acCmdSaveRecord
   lngPtypId = Me!ptyp_id
   lstPlatztypen.Enabled = True
   lstPlatztypen.Requery
   lstPlatztypen.SetFocus
   lstPlatztypen = lngPtypId
   Call lstPlatztypen_AfterUpdate
Else
  MsgBox "Der Platztyp kann nicht gespeichert werden, " & _
         "weil er bereits existiert."
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub
Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strMsgtext As String
Dim lngAntwort As Long
Dim rs As DAO.Recordset

strMsgtext = "Wollen Sie den Platztyp '" & Me!txtPlatztyp & "' wirklich lschen ?"

Set rs = CurrentDb.OpenRecordset("tblPlatz", dbOpenDynaset)
rs.FindFirst "ptyp_id_f=" & Str(Me!ptyp_id)

If rs.NoMatch Then
  lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
  If lngAntwort = vbYes Then
    CurrentDb.Execute ("DELETE FROM tblPlatztyp WHERE ptyp_id=" & Me!ptyp_id)
    lstPlatztypen.Requery
    Requery
    lstPlatztypen.SetFocus
    If Nz(lstPlatztypen.ListCount) > 0 Then   ' Anzeige der ersten Zeile
      Me!lstPlatztypen = Me!lstPlatztypen.ItemData(0)
      Call lstPlatztypen_AfterUpdate
    End If
  End If
Else
  MsgBox "Der Platztyp kann nicht gelscht werden, " & _
         "weil es noch Pltze mit diesem Typ gibt."
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Private Sub txtPlatztyp_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgefhrt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelscht wird!
' Das Drcken der Esc-Taste bewirkt, dass ein gelschter Wert
' wieder hergestellt wird.
' Summa summarun wird alo verhindert, dass der Datensatz mit
' einem leeren Eingabefeld gespeichert wird!

If Nz(Me!txtPlatztyp) = "" Then
   MsgBox "Bitte geben Sie einen Platztyp ein oder drcken Sie die Esc-Taste!"
   Cancel = True
End If
End Sub

Private Sub lstPlatztypen_AfterUpdate()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstPlatztypen) Then Me.Recordset.FindFirst "ptyp_id=" & Me!lstPlatztypen

cmdNeu.Enabled = True
cmdLoeschen.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

========================================================
Code of the form 'frmExport'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

Private Sub cmdStart_Click()
' Writes the VBA code of all forms and modules to an export file "Code_Export.txt"

Dim objObject As Object
Dim mdlModule As Module
Dim modModules As Modules
Dim lngModuleNr As Long
Dim strExportFile As String

strExportFile = Application.CurrentProject.Path & "\Code_Export.txt"

' Does the file 'Export_Code.txt' already exist?

If Dir(strExportFile) <> "" Then
   
   ' If yes - is it not empty?
   
   If FileLen(strExportFile) > 0 Then
      
      MsgBox "The file 'Export_Code.txt' exists already" & vbCrLf & _
             "and is not empty!", vbExclamation, "WARNING"
      Exit Sub
   
   End If
   
End If

' If it does not exist or if it exists and is empty:
' Write the title line

Open strExportFile For Output As #1
Print #1, "++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
Print #1, "++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
Print #1, "VBA Code of the data base '" & Application.CurrentProject.Name & "'"
Print #1, Date
Print #1, "++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
Print #1, "++++++++++++++++++++++++++++++++++++++++++++++++++++++++"

Close #1

Set modModules = Application.Modules

' Loop over all forms
' ===================

For Each objObject In CurrentProject.AllForms
   
   ' Loop over all modules
   
   For lngModuleNr = 0 To modModules.Count - 1
   
      'MsgBox modModules(lngModuleNr).Name & " / " & objObject.Name
      
      ' Does a module exist for the form objObject?
      
      If modModules(lngModuleNr).Name = "Form_" & objObject.Name Then
      
            ' Write the module code to a temporary file 'temptemp.txt'
            
            DoCmd.OutputTo acOutputModule, _
                           modModules(lngModuleNr).Name, _
                           acFormatTXT, _
                           Application.CurrentProject.Path & "\temptemp.txt"

            ' Append the temporary file to the export file 'Code_Export.txt'
            
            WriteFile strExportFile, _
                      ReadFile(strExportFile) & vbCrLf & _
                      "========================================================" & vbCrLf & _
                      "Code of the form '" & objObject.Name & "'" & vbCrLf & _
                      "========================================================" & vbCrLf & _
                      ReadFile(Application.CurrentProject.Path & "\temptemp.txt")

      
      End If
      
   Next lngModuleNr
      
Next objObject

' Loop over all modules
' =====================

For Each objObject In CurrentProject.AllModules

   ' Write the module code to a temporary file 'temptemp.txt'

   DoCmd.OutputTo acOutputModule, _
                  objObject.Name, _
                  acFormatTXT, _
                  Application.CurrentProject.Path & "\temptemp.txt"
   
   ' Append the temporary file to the export file 'Code_Export.txt'
            
   WriteFile strExportFile, _
             ReadFile(strExportFile) & vbCrLf & _
             "**********************************************************************" & vbCrLf & _
             "**********************************************************************" & vbCrLf & _
             "Code of the module '" & objObject.Name & "'" & vbCrLf & _
             "**********************************************************************" & vbCrLf & _
             "**********************************************************************" & vbCrLf & _
             ReadFile(Application.CurrentProject.Path & "\temptemp.txt")
   
Next objObject

Kill Application.CurrentProject.Path & "\temptemp.txt"

MsgBox "Ready!" & vbCrLf & lngModuleNr - 1 & " form(s) and " & vbCrLf & _
                           CurrentProject.AllModules.Count & " module(s) exported to 'Export_Code.txt'!"

End Sub

Function ReadFile(ByRef Path As String) As String
' Quelle: http://vb-tec.de/readfile.htm

Dim FileNr As Long
  
FileNr = FreeFile

Open Path For Binary As #FileNr
ReadFile = Space$(LOF(FileNr))
Get #FileNr, , ReadFile
Close #FileNr

End Function

Sub WriteFile(ByRef Path As String, ByRef Text As String)
' Quelle: http://vb-tec.de/speicher.htm

Dim FileNr As Long
  
FileNr = FreeFile
Open Path For Output As #FileNr
Print #FileNr, Text;
Close #FileNr

End Sub

**********************************************************************
**********************************************************************
Code of the module 'Hilfsprozeduren'
**********************************************************************
**********************************************************************
Attribute VB_Name = "Hilfsprozeduren"
Option Explicit
Option Compare Database

Public Function eigene_MFL_laden()
' Der Wert der Konstanten "Accessversion" wird so gesetzt:
' In VBA: Extras / Eigenschaften von ...
' Dort unter "Argumente fr die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so mssen sie durch Doppelpunkte voneinander getrennt werden!

#If Accessversion > 2003 Then
   Application.LoadCustomUI "Eigene_MFL", _
                            DLookup("mfl_code", "tblMFL", "mfl_name='eigene_MFL'")
#End If

End Function

#If Accessversion > 2003 Then

Sub OnButtonClick(control As IRibbonControl)
Select Case control.id

   Case "startformular"
      DoCmd.OpenForm "frmStart"

   Case "mitglieder"
      DoCmd.OpenForm "frmMitglieder"
   Case "mannschaften"
      DoCmd.OpenForm "frmMannschaften"
   Case "trainer"
      DoCmd.OpenForm "frmTrainer"

   Case "training"
      DoCmd.OpenForm "frmTraining"
   Case "einzelwettkaempfe"
      DoCmd.OpenForm "frmEWettkaempfe"
   Case "mannschaftswettkaempfe"
      DoCmd.OpenForm "frmMWettkaempfe"

   Case "plaetze"
      DoCmd.OpenForm "frmPlaetze"
   Case "beitragssaetze"
      DoCmd.OpenForm "frmBeitragssaetze"
   Case "datentypen"
      DoCmd.OpenForm "frmTypen"

   Case Else
      MsgBox "OnButtonClick: Unbekannter Formularname!"

End Select
End Sub

#End If

Public Function errorhandling() As Boolean
' Wenn Sie errorhandling = True setzen, knnen Sie damit
' eine selbst definierte Fehlermeldung einschalten.
' Das hat den Vorteil, dass der Nutzer keine Laufzeitfehler
' zu sehen bekommt, die oft verwirrend und unverstndlich sind.
' Wie diese selbst geschriebene Fehlerbehandlung funktioniert,
' knnen Sie sich in einer beliebigen Prozedur ansehen.

' Fast alle Prozeduren enthalten nmlich am Ende diesen Code:

'Exit Sub
'fehlerbehandlung:
'   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
'          "FR ENTWICKLER: " & vbCrLf & _
'          "------------------" & vbCrLf & _
'          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
'          "errorhandling = False" & vbCrLf & _
'          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
'          "und zum Debugging wechseln!", vbCritical

errorhandling = False
End Function

Public Function FormIsOpen(formname As String) As Boolean
Dim frm As Form
FormIsOpen = False
For Each frm In Forms
   If frm.Name = formname Then FormIsOpen = True
Next frm
End Function

Public Sub HilfeAnzeigen(strObjektname As String)
'--------------------------------------------------------------
'Hilfe-Datei anzeigen

Dim strDateiname As String
Dim fso As Object

If errorhandling Then On Error GoTo fehlerbehandlung

strDateiname = Application.CurrentProject.Path & "\hilfe-" & strObjektname

' In Access 2003 (= Version 11.0) knnen Textboxen keine .rtf-Daten darstellen.
' Darum dort nur .txt-Dateien als Hilfedateien!

' Der Wert der Konstanten "Accessversion" wird so gesetzt:
' In VBA: Extras / Eigenschaften von ...
' Dort unter "Argumente fr die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so mssen sie durch Doppelpunkte voneinander getrennt werden!

#If Accessversion > 2003 Then
   strDateiname = strDateiname & ".rtf"
#Else
   strDateiname = strDateiname & ".txt"
#End If

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strDateiname) Then
   DoCmd.OpenForm "frmHilfe", , , , , , strDateiname
Else
   MsgBox "Fr dieses Formular existiert leider keine Hilfe-Information."
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
          "FR ENTWICKLER: " & vbCrLf & _
          "------------------" & vbCrLf & _
          "Wenn Sie unter Module / Hilfsprozeduren / errorhandling eingeben:" & vbCrLf & _
          "errorhandling = False" & vbCrLf & _
          "knnen Sie sich die System-Fehlermeldungen anzeigen lassen" & vbCrLf & _
          "und zum Debugging wechseln!", vbCritical

End Sub

Public Function vergeben(vntDatum As Variant, vntZeitVon As Variant, vntZeitBis As Variant, _
                         vntTrainingId As Variant, lngPlaId As Long, vntTrainerId As Variant, _
                         vntTrainmitgliedId As Variant) As Long

' Diese Funktion berprft, ob der Platz, der Trainer oder das trainierende
' Mitglied zu der gewnschten Zeit schon vergeben sind.

' vergeben = 0 bedeutet: Weder Platz, noch Trainer, noch Mitglied sind zu der
'                        gewnschten Zeit schon vergeben.
' vergeben = 1 bedeutet: Der Platz ist zu der gewnschten Zeit schon vergeben.
' vergeben = 2 bedeutet: Der Trainer ist zu der gewnschten Zeit schon vergeben.
' vergeben = 3 bedeutet: Das Mitglied ist zu der gewnschten Zeit schon vergeben.

' vntTrainerId und vntTrainmitgliedId drfen nicht vom Typ Long sein, weil sie auch NULL sein knnen.
' Nur Variablen vom Typ Variant knnen NULL sein.

' vntTrainingId muss ebenfalls vom Typ Variant sein, falls aus irgendeinem Grund
' keine Zeile in der Trainingsliste ausgewhlt wurde.
' Dann liefert aber "If rs!training_id = vntTrainingId" kein True - auch wenn
' beide Werte gleich sind. Daher mu vntTrainingId nochmal auf lngTrainingId
' umgesetzt werden.

'*******************************
' Funktion deaktiviert!!
vergeben = 0
Exit Function
'*******************************

Dim rs As DAO.Recordset
Dim varDatum As String
Dim varZeitvon As String
Dim varZeitbis As String
Dim lngTrainingId As Long
Dim strSQL As String

If IsNull(lngTrainingId) Then
   lngTrainingId = 0
Else
   lngTrainingId = lngTrainingId
End If

'MsgBox Str(lngTrainingId)

' Fr die Verwendung in SQL mssen Datums- und Zeitangaben im amerikanischen
' Format mit jeweils einem # davor und dahinter erfolgen

varDatum = "#" & Month(vntDatum) & "/" & Day(vntDatum) & "/" & Year(vntDatum) & "#"
varZeitvon = "#" & Hour(vntZeitVon) & ":" & Minute(vntZeitVon) & ":" & Second(vntZeitVon) & "#"
varZeitbis = "#" & Hour(vntZeitBis) & ":" & Minute(vntZeitBis) & ":" & Second(vntZeitBis) & "#"

'MsgBox varDatum & "   " & varZeitvon & "   " & varZeitbis

Set rs = CurrentDb.OpenRecordset("tblTraining", dbOpenDynaset, dbReadOnly)

' -----------------------------------------------------
' Ist der Platz zu der gewnschten Zeit schon vergeben?
' -----------------------------------------------------

' Liegt die gewnschte Endzeit in einer vergebenen Trainingszeit?

strSQL = "pla_id_f=" & Str(lngPlaId) & _
          " AND training_datum=" & varDatum & _
          " AND (training_zeitvon<" & varZeitbis & ")" & _
          " AND (training_zeitbis>" & varZeitbis & ")"
'MsgBox strSQL
rs.FindFirst strSQL
If rs.NoMatch Then
   rs.MoveFirst

'  Liegt die gewnschte Anfangszeit in einer vergebenen Trainingszeit?
    
   strSQL = "pla_id_f=" & Str(lngPlaId) & _
             " AND training_datum=" & varDatum & _
             " AND (training_zeitvon<" & varZeitvon & ")" & _
             " AND (training_zeitbis>" & varZeitvon & ")"
'   MsgBox strSQL
   rs.FindFirst strSQL
   If rs.NoMatch Then
      rs.MoveFirst

'     Liegt eine vergebene Trainingszeit komplett innerhalb der gewnschten Trainingszeit?
      
      strSQL = "pla_id_f=" & Str(lngPlaId) & _
                " AND training_datum=" & varDatum & _
                " AND " & varZeitvon & "<=training_zeitvon" & _
                " AND " & varZeitbis & ">=training_zeitbis"
'      MsgBox strSQL
      rs.FindFirst strSQL
      If rs.NoMatch Then
         vergeben = 0
      Else

'        In der Tabelle tblTraining wurde eine Trainingszeit auf demselben Platz gefunden.
'        Jetzt mu noch geprft werden, ob die gefundene Trainingszeit identisch mit
'        der angezeigten Trainingszeit ist. Es knnte nmlich sein, dass nur die Bemerkung
'        oder der Trainer gendert wurden.

         If rs!training_id = lngTrainingId Then
            vergeben = 0
         Else
            vergeben = 1
            rs.Close
            Set rs = Nothing
            Exit Function
'           Wenn man jetzt kein Exit Function macht, dann wird "vergeben" beim nchsten
'           Test (Trainer) wieder auf Null gesetzt !!
         End If
      End If
   
   Else
      If rs!training_id = lngTrainingId Then
         vergeben = 0
      Else
          vergeben = 1
          rs.Close
          Set rs = Nothing
          Exit Function
'         Wenn man jetzt kein Exit Function macht, dann wird "vergeben" beim nchsten
'         Test (Trainer) wieder auf Null gesetzt !!
      End If
   End If

Else
   If rs!training_id = lngTrainingId Then
      vergeben = 0
   Else
       vergeben = 1
       rs.Close
       Set rs = Nothing
       Exit Function
'      Wenn man jetzt kein Exit Function macht, dann wird "vergeben" beim nchsten
'      Test (Trainer) wieder auf Null gesetzt !!
   End If
End If ' If rs.NoMatch Then

' -----------------------------------------------------
' Ist der Trainer zu der gewnschten Zeit schon vergeben?
' -----------------------------------------------------
If Not IsNull(vntTrainerId) Then

' Liegt die gewnschte Endzeit in einer vergebenen Trainingszeit?

strSQL = "trainer_id_f=" & Str(vntTrainerId) & _
          " AND training_datum=" & varDatum & _
          " AND " & varZeitbis & ">training_zeitvon" & _
          " AND " & varZeitbis & "<training_zeitbis"
'MsgBox strSQL
rs.FindFirst strSQL
If rs.NoMatch Then
   rs.MoveFirst

'  Liegt die gewnschte Anfangszeit in einer vergebenen Trainingszeit?
   
   strSQL = "trainer_id_f=" & Str(vntTrainerId) & _
             " AND training_datum=" & varDatum & _
             " AND " & varZeitvon & ">training_zeitvon" & _
             " AND " & varZeitvon & "<training_zeitbis"
'   MsgBox strSQL
   rs.FindFirst strSQL
   If rs.NoMatch Then
      rs.MoveFirst

'     Liegt eine vergebene Trainingszeit komplett innerhalb der gewnschten Trainingszeit?
      
      strSQL = "trainer_id_f=" & Str(vntTrainerId) & _
                " AND training_datum=" & varDatum & _
                " AND " & varZeitvon & "<=training_zeitvon" & _
                " AND " & varZeitbis & ">=training_zeitbis"
'      MsgBox strSQL
      rs.FindFirst strSQL
      If rs.NoMatch Then
         vergeben = 0
      Else

'        In der Tabelle tblTraining wurde eine Trainingszeit mit demselben Trainer gefunden.
'        Jetzt mu noch geprft werden, ob die gefundene Trainingszeit identisch mit
'        der angezeigten Trainingszeit ist. Es knnte nmlich sein, dass nur die Bemerkung
'        oder das trainierende Mitglied gendert wurden.
      
         If rs!training_id = lngTrainingId Then
            vergeben = 0
         Else
            vergeben = 2
            rs.Close
            Set rs = Nothing
            Exit Function
         End If
      End If
   
   Else
      If rs!training_id = lngTrainingId Then
         vergeben = 0
      Else
          vergeben = 2
          rs.Close
          Set rs = Nothing
          Exit Function
      End If
   End If

Else
   If rs!training_id = lngTrainingId Then
      vergeben = 0
   Else
       vergeben = 2
       rs.Close
       Set rs = Nothing
       Exit Function
   End If
End If

End If ' If Not IsNull(trainerkey)

' -----------------------------------------------------
' Ist das Mitglied zu der gewnschten Zeit schon vergeben?
' -----------------------------------------------------
If Not IsNull(vntTrainmitgliedId) Then

' Liegt die gewnschte Endzeit in einer vergebenen Trainingszeit?

strSQL = "mit_id_f=" & Str(vntTrainmitgliedId) & _
         " AND training_datum=" & varDatum & _
         " AND " & varZeitbis & ">training_zeitvon" & _
         " AND " & varZeitbis & "<training_zeitbis"
'MsgBox strSQL
rs.FindFirst strSQL
If rs.NoMatch Then
   rs.MoveFirst

'  Liegt die gewnschte Anfangszeit in einer vergebenen Trainingszeit?
   
   strSQL = "mit_id_f=" & Str(vntTrainmitgliedId) & _
             " AND training_datum=" & varDatum & _
             " AND " & varZeitvon & ">training_zeitvon" & _
             " AND " & varZeitvon & "<training_zeitbis"
'   MsgBox strSQL
   rs.FindFirst strSQL
   If rs.NoMatch Then
      rs.MoveFirst

'     Liegt eine vergebene Trainingszeit komplett innerhalb der gewnschten Trainingszeit?
      
      strSQL = "mit_id_f=" & Str(vntTrainmitgliedId) & _
                " AND training_datum=" & varDatum & _
                " AND " & varZeitvon & "<=training_zeitvon" & _
                " AND " & varZeitbis & ">=training_zeitbis"
'      MsgBox strSQL
      rs.FindFirst strSQL
      If rs.NoMatch Then
         vergeben = 0
      Else

'        In der Tabelle tblTraining wurde eine Trainingszeit mit demselben Mitglied gefunden.
'        Jetzt mu noch geprft werden, ob die gefundene Trainingszeit identisch mit
'        der angezeigten Trainingszeit ist. Es knnte nmlich sein, dass nur die Bemerkung
'        oder der Trainer gendert wurden.
      
         If rs!training_id = lngTrainingId Then
            vergeben = 0
         Else
            vergeben = 3
            rs.Close
            Set rs = Nothing
            Exit Function
         End If
      End If
   
   Else
      If rs!training_id = lngTrainingId Then
         vergeben = 0
      Else
          vergeben = 3
          rs.Close
          Set rs = Nothing
          Exit Function
      End If
   End If

Else
   If rs!training_id = lngTrainingId Then
      vergeben = 0
   Else
      vergeben = 3
       rs.Close
       Set rs = Nothing
       Exit Function
   End If
End If

End If ' If Not IsNull(trainmitgliedkey)

rs.Close
Set rs = Nothing

End Function
