'***************************************************************
'***************************************************************
Andreas Stern: "Keine Angst vor Microsoft Access!"
1.3.2013
www.andreasstern.de
Kompletter VBA-Code der Anwendung "Verleih" (V. 401)
'***************************************************************
'***************************************************************




'***************************************************************
'***************************************************************
"Form_frmAusleihe"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

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

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------

Dim lngBuchId As Long
Dim lngPerId As Long
Dim lngGibtsSchon As Long
Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If Nz(txtBuchtitel) = "" Then
   MsgBox "Bitte wählen Sie ein Buch aus!"
   Exit Sub
End If

If Nz(txtNachname) = "" Then
   MsgBox "Bitte wählen Sie eine Person aus!"
   Exit Sub
End If

If Nz(txtAusVon) = "" Then
   MsgBox "Bitte geben Sie ein Ausleihdatum ein!"
   txtAusVon.SetFocus
   Exit Sub
End If

lngBuchId = Me!frmAusleihe_ufoBuecher!buch_id   ' im UFO ausgewähltes Buch
lngPerId = Me!frmAusleihe_ufoPersonen!per_id    ' im UFO ausgewählte Person

'Ist diese Ausleihe schon eingetragen worden?
'Wenn ja, braucht sie nicht noch einmal eingetragen zu werden.
'(Es muss sich dabei allerdings um einen Eintrag ohne Datum in der
'Spalte AUS_BIS handeln, denn das Buch könnte ja früher schon einmal
'ausgeliehen und wieder zurückgegeben worden sein. Dann würde es sich
'jetzt um eine erneute Ausleihe desselben Buches handeln.)

lngGibtsSchon = DCount("buch_id_f", "tblAusleihe", "buch_id_f=" & Str(lngBuchId) & _
                   " AND per_id_f=" & Str(lngPerId) & _
                   " AND aus_bis IS NULL")
If lngGibtsSchon > 0 Then
   MsgBox "Diese Ausleihe wurde bereits eingetragen!"
   Exit Sub
End If

strSQL = "INSERT INTO tblAusleihe (buch_id_f, per_id_f, aus_von, aus_bemerkung) VALUES (" & _
         Str(lngBuchId) & "," & Str(lngPerId) & "," & _
         "'" & Str(txtAusVon) & "','" & txtBemerkung & "')"
'MsgBox strSQL
CurrentDb.Execute (strSQL)
lblGespeichert.Visible = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

txtBemerkung = ""
txtAusVon = Date
lblGespeichert.Visible = False

' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geöffnet wird,
' soll das dort angeclickte Buch angezeigt werden.
' Ansonsten soll das erste Buch angezeigt werden.

If IsNull(OpenArgs) Then   ' Anzeige des ersten Buches in der Liste

   If Nz(Me!frmAusleihe_ufoBuecher.Form.lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!frmAusleihe_ufoBuecher.Form.lstBuecher = Me!frmAusleihe_ufoBuecher.Form.lstBuecher.ItemData(0)
      Call frmAusleihe_ufoBuecher.Form.public_lstBuecher_AfterUpdate
   End If

Else    ' Anzeige des in einem anderen Formular angeclickten Buches

   Me!frmAusleihe_ufoBuecher.Form.lstBuecher = OpenArgs
   Call frmAusleihe_ufoBuecher.Form.public_lstBuecher_AfterUpdate
   
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmAusleihe_ufoBuecher"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub Form_Current()
Me!lstBuecher = Me!buch_id
End Sub

Public Sub public_lstBuecher_AfterUpdate()
Call lstBuecher_AfterUpdate
End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstBuecher) Then Me.Recordset.FindFirst "buch_id=" & Me!lstBuecher

' Buchtitel im übergeordneten Formular anzeigen

Parent!txtBuchtitel = Me!txtTitel
Parent!lblGespeichert.Visible = False

' Ist dieses Buch bereits ausgeliehen?

If DCount("aus_id", "tblAusleihe", "buch_id_f=" & Str(lstBuecher) & _
                                  " AND aus_bis IS NULL") > 0 Then
   Parent!txtAusgeliehen.Caption = "Dieses Buch ist ausgeliehen seit dem " & _
         DLookup("aus_von", "tblAusleihe", "buch_id_f=" & Str(lstBuecher) & _
                                           " AND aus_bis IS NULL")
   Parent!txtAusgeliehen.Visible = True
   Parent!cmdSpeichern.Enabled = False
Else
   Parent!txtAusgeliehen.Visible = False
   Parent!cmdSpeichern.Enabled = True
End If

lstBuecher.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdBuchsuchen_Click()
'--------------------------------------------------------------
'Öffne das Suchfenster

If errorhandling Then On Error GoTo fehlerbehandlung

Screen.PreviousControl.SetFocus
DoCmd.RunCommand acCmdFind

' Es ginge auch so:
' DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
' Das ist aber ein veralteter Befehl, der schon in MS Access 97
' durch RunCommand ersetzt wurde.

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Anzeige des ersten Datensatzes in der Liste

If errorhandling Then On Error GoTo fehlerbehandlung

Me!lstBuecher.SetFocus
If Nz(lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
   Me!lstBuecher = Me!lstBuecher.ItemData(0)
   Call lstBuecher_AfterUpdate
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical
End Sub


'***************************************************************
'***************************************************************
"Form_frmAusleihe_ufoPersonen"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cmdPersonsuchen_Click()
'--------------------------------------------------------------
'Öffne das Suchfenster

If errorhandling Then On Error GoTo fehlerbehandlung

Screen.PreviousControl.SetFocus
DoCmd.RunCommand acCmdFind

' Es ginge auch so:
' DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
' Das ist aber ein veralteter Befehl, der schon in MS Access 97
' durch RunCommand ersetzt wurde.

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Anzeige des ersten Datensatzes in der Liste

If errorhandling Then On Error GoTo fehlerbehandlung

'Me!lstPersonen.SetFocus
'If Nz(lstPersonen.ListCount) > 0 Then   ' erste Zeile auswählen
'   Me!lstPersonen = Me!lstPersonen.ItemData(0)
'   Call lstPersonen_AfterUpdate
'End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical
   
End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstPersonen) Then Me.Recordset.FindFirst "per_id=" & Me!lstPersonen

'Name und Nachname im übergeordneten Formular anzeigen

Parent!txtNachname = Me!txtName
Parent!txtVorname = Me!txtVorname

Parent!lblGespeichert.Visible = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub



'***************************************************************
'***************************************************************
"Form_frmAutoren"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cmdAlleAutoren_Click()
DoCmd.OpenReport "rptAutoren", acViewPreview
End Sub

Private Sub cmdEinenAutor_Click()
DoCmd.OpenReport "rptAutoren", acViewPreview, , "autor_id=" & Me!autor_id
End Sub

Private Sub Form_Current()
'--------------------------------------------------------------
' Markiert in der Liste den im Formular per PgUp / PgDown ausgewählten Datensatz
'Me!lstAutoren = Me!autor_id
End Sub

Private Sub txtBemerkung_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgeführt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelöscht wird!
' Das Drücken der Esc-Taste bewirkt, dass ein gelöschter 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 drücken Sie die Esc-Taste!"
   Cancel = True
End If

End Sub

Private Sub txtName_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtVorname_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstAutoren) Then Me.Recordset.FindFirst "autor_id=" & Str(Me!lstAutoren)

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

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

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
' Einen Autor löschen
' (alternative Technik in frmOrte!)

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

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde ein zu löschender Datensatz ausgewählt?

If IsNull(lstAutoren) Then
   MsgBox "Bitte wählen Sie den zu löschenden Autor aus der Liste!"
   lstAutoren.SetFocus
   Exit Sub
End If

strMsgtext = "Wollen Sie " & Nz(AUTOR_VORNAME) & " " & Me!AUTOR_NAME & " wirklich löschen?"

'Gibt es noch Datensätze in anderen Tabellen, die mit dem zu löschenden
'Datensatz in Beziehung stehen ?

Set rs = CurrentDb.OpenRecordset("tblAutor_Buch", dbOpenDynaset)
rs.FindFirst "autor_id_f=" & Str(Me!autor_id)

If rs.NoMatch Then
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   If lngAntwort = vbYes Then
      CurrentDb.Execute "DELETE FROM tblAutor WHERE autor_id=" & Str(Me!autor_id)
      lstAutoren.Requery
      Requery
      
      Me!lstAutoren.SetFocus
      If Nz(lstAutoren.ListCount) > 0 Then   ' erste Zeile auswählen
         Me!lstAutoren = Me!lstAutoren.ItemData(0)
         Call lstAutoren_AfterUpdate
      End If
      
   End If
Else
   MsgBox "Dieser Autor kann nicht gelöscht werden!" & vbCrLf & _
          "Es gibt noch Bücher von ihm."
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If errorhandling Then On Error GoTo fehlerbehandlung

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

' Gibt es diesen Autoren schon?

If (txtName <> txtName.OldValue Or txtVorname <> txtVorname.OldValue) And _
    DCount("autor_id", "tblAutor", "autor_name='" & txtName & "' AND " & _
                                   "autor_vorname='" & txtVorname & "'") > 0 Then
   MsgBox ("Diesen Autor gibt es schon!")
   Me.Undo   ' Abbrechen der begonnenen Transaktion (Datensatzmarkierer beobachten!!)
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lngAutorId = Me!autor_id

lstAutoren.Enabled = True
lstAutoren.Requery
lstAutoren.SetFocus

' Anzeige des gerade gespeicherten Autors

lstAutoren = lngAutorId
Call lstAutoren_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
'Neuen Autor eingeben

If errorhandling Then On Error GoTo fehlerbehandlung


DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

lstAutoren = Null
cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstAutoren.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geöffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstAutoren.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstAutoren.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!lstAutoren = Me!lstAutoren.ItemData(0)
      Call lstAutoren_AfterUpdate
   End If

Else
   Me!lstAutoren = OpenArgs
   Call lstAutoren_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub



'***************************************************************
'***************************************************************
"Form_frmAutoren_ufoBuecher"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtBuch_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmBuecher", , , , , , Me!buch_id
End Sub

Private Sub txtLager_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmLager", , , , , , Me!lager_id
End Sub

Private Sub txtOrt_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmOrte", , , , , , Me!ort_id
End Sub


'***************************************************************
'***************************************************************
"Form_frmBuecher"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cboLager_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 führen kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

Private Sub cboLager_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Sicherheitsmaßnahme gegen versehentliches Ändern von Daten durch
' Clicken in ein Kombinationsfeld
' Beim erstmaligen Eintrag von Daten (OldValue=Null) wird nicht nachgefragt.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboLager.OldValue) Then Exit Sub
If MsgBox("Wollen Sie das Lager wirklich ändern?", vbYesNo + vbDefaultButton2) = vbNo Then _
   Cancel = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboLager_GotFocus()
'--------------------------------------------------------------
' Wenn der Inhalt der Combobox in einem anderen Formular geändert wurde,
' soll die Änderung hier sofort sichtbar werden

If errorhandling Then On Error GoTo fehlerbehandlung

cboLager.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboVerlag_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
' führen kann, wird die gerade begonnene Transaktion auch
' sofort wieder durch einen "Speichern"-Befehl beendet.

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.RunCommand (acCmdSaveRecord)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboVerlag_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Sicherheitsmaßnahme gegen versehentliches Ändern von Daten
' durch Clicken in ein Kombinationsfeld
' Beim erstmaligen Eintrag von Daten (OldValue=Null)
' wird nicht nachgefragt.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboVerlag.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Verlag wirklich ändern?", _
           vbYesNo + vbDefaultButton2) = vbNo Then Cancel = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboVerlag_GotFocus()
'--------------------------------------------------------------
' Wenn der Inhalt des Kombinationsfeldes in einem ANDEREN Formular
' geändert wurde, soll die Änderung hier sofort sichtbar werden

If errorhandling Then On Error GoTo fehlerbehandlung

cboVerlag.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboZustand_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 führen kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.RunCommand (acCmdSaveRecord)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboZustand_GotFocus()
'--------------------------------------------------------------
' Wenn der Inhalt der Combobox in einem anderen Formular geändert wurde,
' soll die Änderung hier sofort sichtbar werden

If errorhandling Then On Error GoTo fehlerbehandlung

cboZustand.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub lstAutoren_GotFocus()
lstAutoren.Requery
End Sub

Private Sub txtBemerkung_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtTitel_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgeführt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelöscht wird!
' Das Drücken der Esc-Taste bewirkt, dass ein gelöschter 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!txtTitel) = "" Then
   MsgBox "Bitte geben Sie einen Titel ein oder drücken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtTitel_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtNummer_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtJahr_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstBuecher) Then Me.Recordset.FindFirst "buch_id=" & Me!lstBuecher

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

' Jetzt können Autoren zugewiesen werden

cmdRueber.Enabled = True
cmdZurueck.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

Private Sub cmdRueber_Click()
'--------------------------------------------------------------
'Einen Autor zum Buch hinzufügen
Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde in der rechten Liste ein Autor angeclickt?

If IsNull(lstAutoren) Then
   MsgBox "Bitte wählen Sie einen Autor aus der rechten Liste!"
   Exit Sub
End If

' KANN WEG! Vorsorge in cmdNeu_Click!

' Wenn der Nutzer den Button "neu" drückt, einige Buchdaten eingibt
' und dann einen Autor zuweisen will, so geht das nicht, weil sich das neue
' Buch noch nicht in der Tabelle tblBuch befindet, d.h. es hat noch keinen Wert
' für buch_id. Dann kann auch kein Eintrag in die Tabelle BUCH_AUTOR erfolgen.
' Daher muss das neue Buch erst einmal gespeichert werden.

'If Nz(txtTitel)="" Then
'   MsgBox "Bitte geben Sie einen Titel ein!"
'   txtTitel.SetFocus
'   Exit Sub
'End If
'
'DoCmd.RunCommand acCmdSaveRecord
'lstBuecher.Requery

'Wurde der in der Autorenliste angeclickte Autor dem Buch bereits zugewiesen?

If DCount("buch_id_f", "tblAutor_Buch", "buch_id_f=" & Str(Me!buch_id) & _
          " AND autor_id_f=" & Str(lstAutoren)) > 0 Then Exit Sub

'Wenn nicht, dann erfolgt jetzt die Zuweisung

strSQL = "INSERT INTO tblAutor_Buch (buch_id_f, autor_id_f) " & _
         "VALUES (" & Str(Me!buch_id) & "," & Str(lstAutoren) & ")"
'MsgBox strSQL
CurrentDb.Execute strSQL
Forms!frmBuecher!frmBuecher_ufoAutoren.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdSachgebiete_Click()
'--------------------------------------------------------------
' Wenn der Nutzer den Button "Buch hinzufügen" drückt, einige Buchdaten eingibt
' und dann Sachgebiete zuweisen will, so geht das nicht, weil sich das neue
' Buch noch nicht in der Tabelle tblBuch befindet, d.h. es hat noch keinen Wert
' für buch_id. Dann kann auch kein Eintrag in die Tabelle tblBuch_Sach erfolgen.
' Daher muss das neue Buch erst einmal gespeichert werden.

If errorhandling Then On Error GoTo fehlerbehandlung

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

DoCmd.RunCommand acCmdSaveRecord
lstBuecher.Requery

'... und jetzt können Sachgebiete zugewiesen werden!
DoCmd.OpenForm "frmZuweisung", , , , , , Str(Me!buch_id)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, 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, vbCritical

End Sub
Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Ein Buch löschen
'(alternative Technik in frmOrte!)

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

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde ein zu löschender Datensatz ausgewählt?

If IsNull(lstBuecher) Then
   MsgBox "Bitte wählen Sie das zu löschende Buch aus der Liste!"
   lstBuecher.SetFocus
   Exit Sub
End If

strMsgtext = "Wollen Sie das Buch " & vbCrLf & Me!BUCH_TITEL & vbCrLf & " wirklich löschen?"

' Ist das Buch noch ausgeliehen?

Set rs = CurrentDb.OpenRecordset("tblAusleihe", dbOpenDynaset)
rs.FindFirst "buch_id_f=" & Str(Me!buch_id) & " AND aus_bis IS NULL"

If rs.NoMatch Then
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   If lngAntwort = vbYes Then
      CurrentDb.Execute "DELETE FROM tblAusleihe WHERE buch_id_f=" & Str(Me!buch_id)
      CurrentDb.Execute "DELETE FROM tblAutor_Buch WHERE buch_id_f=" & Str(Me!buch_id)
      CurrentDb.Execute "DELETE FROM tblBuch_Sach WHERE buch_id_f=" & Str(Me!buch_id)
      CurrentDb.Execute "DELETE FROM tblBuch WHERE buch_id=" & Str(Me!buch_id)
  
      Requery
      lstBuecher.Requery
      lstBuecher = Me!buch_id
      
      Me!lstBuecher.SetFocus
      If Nz(lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
         Me!lstBuecher = Me!lstBuecher.ItemData(0)
         Call lstBuecher_AfterUpdate
      End If
   
   End If
Else
   MsgBox "Dieses Buch kann nicht gelöscht werden," & vbCrLf & _
          "weil es noch ausgeliehen ist!"
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

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

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If errorhandling Then On Error GoTo fehlerbehandlung

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

DoCmd.RunCommand acCmdSaveRecord
lngBuchId = Me!buch_id

' Jetzt können Autoren zugewiesen werden

cmdRueber.Enabled = True
cmdZurueck.Enabled = True

lstBuecher.Enabled = True
lstBuecher.Requery
lstBuecher.SetFocus
lstBuecher = lngBuchId
Call lstBuecher_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub
Private Sub cmdNeu_Click()
'--------------------------------------------------------------
'Ein neues Buch anlegen

If errorhandling Then On Error GoTo fehlerbehandlung

lstBuecher = Null
DoCmd.GoToRecord , , acNewRec
txtTitel.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstBuecher.Enabled = False

' Wenn der Nutzer den Button "neu" drückt, einige Buchdaten eingibt
' und dann einen Autor zuweisen will, so geht das nicht, weil sich das neue
' Buch noch nicht in der Tabelle tblBuch befindet, d.h. es hat noch keinen Wert
' für buch_id. Dann kann auch kein Eintrag in die Tabelle BUCH_AUTOR erfolgen.
' Daher muss das neue Buch erst einmal gespeichert werden.

cmdRueber.Enabled = False
cmdZurueck.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdZurueck_Click()
'--------------------------------------------------------------
'Einen Autor aus der Liste der Autoren des Buches entfernen

Dim lngAutorId As Long

If errorhandling Then On Error GoTo fehlerbehandlung

lngAutorId = Forms!frmBuecher!frmBuecher_ufoAutoren!autor_id
CurrentDb.Execute "DELETE FROM tblAutor_Buch WHERE " & _
                  "autor_id_f=" & Str(lngAutorId) & " AND " & _
                  "buch_id_f=" & Str(Me!buch_id)
Forms!frmBuecher!frmBuecher_ufoAutoren.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboZustand_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Sicherheitsmaßnahme gegen versehentliches Ändern von Daten durch
' Clicken in ein Kombinationsfeld
' Beim erstmaligen Eintrag von Daten (OldValue=Null) wird nicht nachgefragt.

If IsNull(cboZustand.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Zustand wirklich ändern?", vbYesNo + vbDefaultButton2) = vbNo Then _
   Cancel = True
End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1
Me!lstBuecher.SetFocus
   
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geöffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

If IsNull(OpenArgs) Then   ' Anzeige des ersten Buches in der Liste

   If Nz(lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!lstBuecher = Me!lstBuecher.ItemData(0)
      Call lstBuecher_AfterUpdate
   End If

Else    ' Anzeige des in einem anderen Formular angeclickten Buches
   Me!lstBuecher = OpenArgs
   Call lstBuecher_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmBuecher_ufoAutoren"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

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


'***************************************************************
'***************************************************************
"Form_frmBuechersuche"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Public Sub public_lstBuecher_AfterUpdate()
Call lstBuecher_AfterUpdate
End Sub

Public Sub Public_BuchdatenLoeschen()

If errorhandling Then On Error GoTo fehlerbehandlung


Me!lstAutoren.RowSourceType = "Table/Query"
Me!lstAutoren.RowSource = ""

txtVerlag = ""
txtJahr = ""
txtZustand = ""
txtNummer = ""
txtLager = ""
txtOrt = ""
txtBemerkung = ""

'Weiß färben der Datenfelder

lstAutoren.BackColor = RGB(255, 255, 255)
txtVerlag.BackColor = RGB(255, 255, 255)
txtJahr.BackColor = RGB(255, 255, 255)
txtZustand.BackColor = RGB(255, 255, 255)
txtNummer.BackColor = RGB(255, 255, 255)
txtLager.BackColor = RGB(255, 255, 255)
txtOrt.BackColor = RGB(255, 255, 255)
txtBemerkung.BackColor = RGB(255, 255, 255)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub lstBuecher_AfterUpdate()
'--------------------------------------------------------------
'Anzeige der Daten des ausgewählten Buches

Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Zeige in der Autorenliste die Autoren zu dem ausgewählten Buch an

strSQL = "SELECT tblAutor.autor_id, tblAutor.autor_name, tblAutor.autor_vorname " & _
         "FROM tblAutor INNER JOIN tblAutor_Buch " & _
         "ON tblAutor.autor_id = tblAutor_Buch.autor_id_f " & _
         "WHERE tblAutor_Buch.buch_id_f = " & Str(lstBuecher)

'Debug.Print strSQL

Me!lstAutoren.RowSourceType = "Table/Query"
Me!lstAutoren.RowSource = strSQL

'Zeige die übrigen Daten zu dem ausgewählten Buch an

txtVerlag = DLookup("ver_name", "qryBuch", "buch_id=" & Str(lstBuecher))
txtJahr = DLookup("buch_jahr", "qryBuch", "buch_id=" & Str(lstBuecher))
txtZustand = DLookup("zust_name", "qryBuch", "buch_id=" & Str(lstBuecher))
txtNummer = DLookup("buch_nummer", "qryBuch", "buch_id=" & Str(lstBuecher))
txtLager = DLookup("lager_bezeichnung", "qryBuch", "buch_id=" & Str(lstBuecher))
txtOrt = DLookup("ort_bezeichnung", "qryBuch", "buch_id=" & Str(lstBuecher))
txtBemerkung = DLookup("buch_bemerkung", "qryBuch", "buch_id=" & Str(lstBuecher))

'Färben der Datenfelder
lstAutoren.BackColor = RGB(164, 213, 226)
txtVerlag.BackColor = RGB(164, 213, 226)
txtJahr.BackColor = RGB(164, 213, 226)
txtZustand.BackColor = RGB(164, 213, 226)
txtNummer.BackColor = RGB(164, 213, 226)
txtLager.BackColor = RGB(164, 213, 226)
txtOrt.BackColor = RGB(164, 213, 226)
txtBemerkung.BackColor = RGB(164, 213, 226)

' Ist dieses Buch bereits ausgeliehen?

If DCount("aus_id", "tblAusleihe", "buch_id_f=" & Str(lstBuecher) & _
                                  " AND aus_bis IS NULL") > 0 Then
   txtAusgeliehen.Caption = "Dieses Buch ist ausgeliehen seit dem " & _
         DLookup("aus_von", "tblAusleihe", "buch_id_f=" & Str(lstBuecher) & _
                                           " AND aus_bis IS NULL")
   txtAusgeliehen.Visible = True
Else
   txtAusgeliehen.Visible = False
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

Private Sub cmdObersachgebiet_Click()
'--------------------------------------------------------------
' Mache das Obersachgebiet des aktuellen Sachgebietes zum aktuellen Sachgebiet
' (Oder, mit anderen Worten: Gehe im Sachgebietsbaum einen Schritt zurück)

Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Zeige das Obersachgebiet an

txtAktuellesSachgebiet = Me!OBERSACHGEBIET

'Mache das Obersachgebiet zum aktuellen Sachgebiet

Me.Filter = "tblSachgebiet.sachgebiet='" & Me!OBERSACHGEBIET & "'"
Me.FilterOn = True

'Zeige in der Bücherliste die Bücher zum aktuellen Sachgebiet an

strSQL = "SELECT tblBuch.buch_id, tblBuch.BUCH_TITEL " & _
          "FROM tblBuch_Sach INNER JOIN tblBuch " & _
          "ON tblBuch.buch_id = tblBuch_Sach.buch_id_f " & _
          "WHERE tblBuch_Sach.sachgebiet ='" & txtAktuellesSachgebiet & "'"

Me!lstBuecher.RowSourceType = "Table/Query"
Me!lstBuecher.RowSource = strSQL

' Anzeige der ersten Zeile der Liste

If Nz(lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
   Me!lstBuecher = Me!lstBuecher.ItemData(0)
   Call lstBuecher_AfterUpdate
Else
   Call Public_BuchdatenLoeschen
   txtAusgeliehen.Visible = False
End If

lstSachgebiete = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdOberstesSachgebiet_Click()
'--------------------------------------------------------------
' Zurück zum obersten Sachgebiet

Dim rs As DAO.Recordset
Dim strOberstesSachgebiet As String
Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Finde das oberste Sachgebiet

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"
strOberstesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

'Zeige das oberste Sachgebiet an

txtAktuellesSachgebiet = strOberstesSachgebiet

'Mache das oberste Sachgebiet zum aktuellen Sachgebiet

Me.Filter = "tblSachgebiet.sachgebiet='" & strOberstesSachgebiet & "'"
Me.FilterOn = True

'Zeige in der Bücherliste die Bücher zum aktuellen Sachgebiet an

strSQL = "SELECT tblBuch.buch_id, tblBuch.BUCH_TITEL " & _
          "FROM tblBuch_Sach INNER JOIN tblBuch " & _
          "ON tblBuch.buch_id = tblBuch_Sach.buch_id_f " & _
          "WHERE tblBuch_Sach.sachgebiet ='" & txtAktuellesSachgebiet & "'"

Me!lstBuecher.RowSourceType = "Table/Query"
Me!lstBuecher.RowSource = strSQL

' Anzeige der ersten Zeile der Liste

If Nz(lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
   Me!lstBuecher = Me!lstBuecher.ItemData(0)
   Call lstBuecher_AfterUpdate
Else
   Call Public_BuchdatenLoeschen
   txtAusgeliehen.Visible = False
End If

lstSachgebiete = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, 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, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
'Zeige nach dem Öffnen das oberste Sachgebiet an!

Dim rs As DAO.Recordset

Me.Cycle = 1

If errorhandling Then On Error GoTo fehlerbehandlung

'Finde das oberste Sachgebiet

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"

If rs.NoMatch Then
   MsgBox "Es gibt kein Sachgebiet, bei dem sachgebiet=obersachgebiet ist" & vbCrLf & _
          "(oberstes Sachgebiet). Bitte legen Sie ein solches Sachgebiet an," & vbCrLf & _
          "sonst wird dieses Formular nicht funktionieren!"
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

txtAktuellesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

'Die Filterung sorgt dafür, dass im Unterformular die zum aktuellen
'Sachgebiet gehörenden Untersachgebiete angezeigt werden.

Me.Filter = "tblSachgebiet.sachgebiet='" & txtAktuellesSachgebiet & "'"
Me.FilterOn = True

'Leeren der Autorenliste

Me!lstAutoren.RowSourceType = "Table/Query"
Me!lstAutoren.RowSource = ""
Me!lstAutoren.Requery

'Leeren der Bücherliste

Me!lstBuecher.RowSourceType = "Table/Query"
Me!lstBuecher.RowSource = ""
Me!lstBuecher.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub lstBuecher_DblClick(Cancel As Integer)
'--------------------------------------------------------------
' Von der Suche direkt zur Ausleihe

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmAusleihe", , , , , , Me!lstBuecher

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Mache das in der Liste angeclickte Sachgebiet zum aktuellen Sachgebiet
txtAktuellesSachgebiet = lstSachgebiete

'Die Filterung sorgt dafür, dass im Unterformular die zum aktuellen
'Sachgebiet gehörenden Untersachgebiete angezeigt werden.
' ACHTUNG: Die Anzeige ALLER Sachgebiete in der Liste bleibt davon unbeeinflusst!
'          Es wird nur die Datenquelle DES FORMULARS gefiltert!

Me.Filter = "tblSachgebiet.sachgebiet='" & txtAktuellesSachgebiet & "'"
Me.FilterOn = True

'Zeige in der Bücherliste die Bücher zum aktuellen Sachgebiet an

strSQL = "SELECT tblBuch.buch_id, tblBuch.buch_titel " & _
          "FROM tblBuch_Sach INNER JOIN tblBuch " & _
          "ON tblBuch.buch_id = tblBuch_Sach.buch_id_f " & _
          "WHERE tblBuch_Sach.sachgebiet ='" & txtAktuellesSachgebiet & "'" & _
          " ORDER BY tblBuch.buch_titel"

lstBuecher.RowSourceType = "Table/Query"
lstBuecher.RowSource = strSQL

' Anzeige der ersten Zeile der Liste

If Nz(lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
   Me!lstBuecher = Me!lstBuecher.ItemData(0)
   Call lstBuecher_AfterUpdate
Else
   Call Public_BuchdatenLoeschen
End If

' funktioniert NICHT:
'lstBuecher.SetFocus
'lstBuecher.Selected(0) = True
'Call lstBuecher_AfterUpdate

'funktioniert NICHT:
'Me!frmBuechersuche_ufoUntersachgebiete.Filter = _
'      "tblSachgebiet.sachgebiet='" & txtAktuellesSachgebiet & "'"
'Me!frmBuechersuche_ufoUntersachgebiete.FilterOn = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmBuechersuche_ufoUntersachgebiete"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtSachgebiet_Click()
'--------------------------------------------------------------
'Mache das angeclickte Untersachgebiet zum aktuellen Sachgebiet
'und zeige die dazugehörigen Bücher an.

Dim strSQL As String

If errorhandling Then On Error GoTo fehlerbehandlung

Parent!txtAktuellesSachgebiet = txtSachgebiet

'Die Filterung sorgt dafür, dass im Unterformular die zum aktuellen
'Sachgebiet gehörenden Untersachgebiete angezeigt werden.

Parent.Filter = "tblSachgebiet.sachgebiet='" & txtSachgebiet & "'"
Parent.FilterOn = True
Parent!txtAktuellesSachgebiet.SetFocus

'Zeige in der Bücherliste die Bücher zum aktuellen Sachgebiet an

strSQL = "SELECT tblBuch.buch_id, tblBuch.buch_titel " & _
         "FROM tblBuch_Sach INNER JOIN tblBuch " & _
         "ON tblBuch.buch_id = tblBuch_Sach.buch_id_f " & _
         "WHERE tblBuch_Sach.sachgebiet ='" & Parent!txtAktuellesSachgebiet & "'" & _
         " ORDER BY tblBuch.buch_titel"

Parent!lstBuecher.RowSourceType = "Table/Query"
Parent!lstBuecher.RowSource = strSQL

Parent!lstBuecher.SetFocus
If Nz(Parent!lstBuecher.ListCount) > 0 Then   ' erste Zeile auswählen
   Parent!lstBuecher = Parent!lstBuecher.ItemData(0)
   Call Parent.public_lstBuecher_AfterUpdate
Else
   Call Parent.Public_BuchdatenLoeschen
End If

Parent!lstSachgebiete = Null

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmErsterStart"
'***************************************************************
'***************************************************************

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



'***************************************************************
'***************************************************************
"Form_frmHilfe"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

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 objFso As Object
Dim objF As Object
Dim objTs As Object
Dim lngFiletype As Long

If IsNull(Me.OpenArgs) Then Exit Sub

' Der zweite Parameter der Funktion OpenAsTextStream hängt vom Format
' der zu öffnenden Datei ab.

' Der Wert der Konstanten "Accessversion" wird so gesetzt:
' In VBA: Extras / Eigenschaften von ...
' Dort unter "Argumente für die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so müssen 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 objFso = CreateObject("Scripting.FileSystemObject")
Set objF = objFso.GetFile(Me.OpenArgs)
Set objTs = objF.OpenAsTextStream(1, lngFiletype)

Me.txtHilfetext = objTs.ReadAll
Me!txtHilfetext.Locked = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmLager"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cboLagertyp_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 führen kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.RunCommand (acCmdSaveRecord)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboLagertyp_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Sicherheitsmaßnahme gegen versehentliches Ändern von Daten durch
' Clicken in ein Kombinationsfeld
' Beim erstmaligen Eintrag von Daten (OldValue=Null) wird nicht nachgefragt.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboLagertyp.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Lagertyp wirklich ändern?", vbYesNo + vbDefaultButton2) = vbNo Then Cancel = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboLagertyp_GotFocus()
'--------------------------------------------------------------
' Wenn der Inhalt der Combobox in einem anderen Formular geändert wurde,
' soll die Änderung hier sofort sichtbar werden

If errorhandling Then On Error GoTo fehlerbehandlung

cboLagertyp.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboOrt_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 führen kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.RunCommand (acCmdSaveRecord)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboOrt_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Sicherheitsmaßnahme gegen versehentliches Ändern von Daten durch
' Clicken in ein Kombinationsfeld
' Beim erstmaligen Eintrag von Daten (OldValue=Null) wird nicht nachgefragt.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboOrt.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Ort wirklich ändern?", vbYesNo + vbDefaultButton2) = vbNo Then Cancel = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboOrt_GotFocus()
'--------------------------------------------------------------
' Wenn der Inhalt der Combobox in einem anderen Formular geändert wurde,
' soll die Änderung hier sofort sichtbar werden

If errorhandling Then On Error GoTo fehlerbehandlung

cboOrt.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

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

Me!lstLager.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstLager.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!lstLager = Me!lstLager.ItemData(0)
      Call lstLager_AfterUpdate
   End If

Else
   Me!lstLager = OpenArgs
   Call lstLager_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub LAGER_BEZEICHNUNG_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstLager) Then Me.Recordset.FindFirst "lager_id=" & Me!lstLager

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

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

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Ein Lager löschen
' (alternative Technik in frmOrte!)

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

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde ein zu löschender Datensatz ausgewählt?
If IsNull(lstLager) Then
   MsgBox "Bitte wählen Sie das zu löschende Lager aus der Liste!"
   lstLager.SetFocus
   Exit Sub
End If

strMsgtext = "Wollen Sie das Lager " & Me!LAGER_BEZEICHNUNG & " wirklich löschen?"

'Gibt es noch Datensätze in anderen Tabellen, die mit dem zu löschenden
'Datensatz in Beziehung stehen ?

Set rs = CurrentDb.OpenRecordset("tblBuch", dbOpenDynaset)
rs.FindFirst "lager_id_f=" & Str(Me!lager_id)

If rs.NoMatch Then
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   rs.Close
   Set rs = Nothing
   If lngAntwort = vbNo Then Exit Sub
   CurrentDb.Execute "DELETE FROM tblLager WHERE lager_id=" & Str(Me!lager_id)
   lstLager.Requery
   Requery

   Me!lstLager.SetFocus
   If Nz(lstLager.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!lstLager = Me!lstLager.ItemData(0)
      Call lstLager_AfterUpdate
   End If

Else
   MsgBox "Dieses Lager kann nicht gelöscht werden!" & vbCrLf & _
          "Es enthält noch Bücher."
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngLagerId 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

If IsNull(cboLagertyp) Then
   MsgBox "Bitte wählen Sie einen Lagertyp aus!"
   Exit Sub
End If

If IsNull(cboOrt) Then
   MsgBox "Bitte wählen Sie einen Ort aus!"
   Exit Sub
End If

' Gibt es diese Bezeichnung schon an dem ausgewählten Ort?

If (txtBezeichnung <> txtBezeichnung.OldValue Or cboOrt <> cboOrt.OldValue) And _
    DCount("lager_id", "tblLager", "lager_bezeichnung='" & txtBezeichnung & "' AND " & _
                                   "ort_id_f=" & Str(cboOrt)) > 0 Then
   MsgBox ("Diese Lagerbezeichnung gibt es schon an dem Ort." & vbCrLf & _
           "Bitte wählen Sie eine andere Bezeichnung!")
   Me.Undo    ' Abbrechen der begonnenen Transaktion (Datensatzmarkierer beobachten!!)
   txtBezeichnung.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lngLagerId = Me!lager_id

lstLager.Enabled = True
lstLager.Requery
lstLager.SetFocus
lstLager = lngLagerId
Call lstLager_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

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

If errorhandling Then On Error GoTo fehlerbehandlung

lstLager = Null
DoCmd.GoToRecord , , acNewRec
txtBezeichnung.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstLager.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtBezeichnung_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgeführt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelöscht wird!
' Das Drücken der Esc-Taste bewirkt, dass ein gelöschter 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 drücken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmLager_ufoBuecher"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtBuch_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmBuecher", , , , , , Me!buch_id
End Sub


'***************************************************************
'***************************************************************
"Form_frmOrte"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

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

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

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

Me!lstOrte.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstOrte.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!lstOrte = Me!lstOrte.ItemData(0)
      Call lstOrte_AfterUpdate
   End If

Else
   Me!lstOrte = OpenArgs
   Call lstOrte_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub ORT_BEMERKUNG_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub ORT_BEZEICHNUNG_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub lstOrte_AfterUpdate()
'--------------------------------------------------------------
'In der Liste ausgewählten Datensatz anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstOrte) Then Me.Recordset.FindFirst "ort_id=" & Me!lstOrte

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

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

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
' Einen Ort löschen
' (alternative Variante!)

Dim strMsgtext As String

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde ein zu löschender Datensatz ausgewählt?

If IsNull(lstOrte) Then
   MsgBox "Bitte wählen Sie den zu löschenden Ort aus der Liste!"
   lstOrte.SetFocus
   Exit Sub
End If

strMsgtext = "Wollen Sie den Ort " & Me!txtBezeichnung & " wirklich löschen?"

If MsgBox(strMsgtext, vbYesNo + vbDefaultButton2) = vbYes Then

   'Gibt es noch Datensätze in anderen Tabellen, die mit dem zu löschenden
   'Datensatz in Beziehung stehen ?

   If DCount("lager_id", "tblLager", "ort_id_f=" & Me!ort_id) > 0 Then
      MsgBox "Dieser Ort kann nicht gelöscht werden!" & vbCrLf & _
             "Es gibt dort noch mindestens ein Lager."
   Else
      CurrentDb.Execute "DELETE FROM tblOrt WHERE ort_id=" & Str(Me!ort_id)
      lstOrte.Requery
      Requery

      Me!lstOrte.SetFocus
      If Nz(lstOrte.ListCount) > 0 Then   ' erste Zeile auswählen
         Me!lstOrte = Me!lstOrte.ItemData(0)
         Call lstOrte_AfterUpdate
      End If
   
   End If

End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim lngOrtId 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

' Gibt es diesen Ort schon?

If txtBezeichnung <> txtBezeichnung.OldValue And _
   DCount("ort_id", "tblOrt", "ort_bezeichnung='" & txtBezeichnung & "'") > 0 Then
   MsgBox ("Diesen Ort gibt es schon!")
   Me.Undo   ' Abbrechen der begonnenen Transaktion (Datensatzmarkierer beobachten!!)
   txtBezeichnung.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lngOrtId = Me!ort_id

lstOrte.Enabled = True
lstOrte.Requery
lstOrte.SetFocus

' Anzeige des gespeicherten Ortes

lstOrte = lngOrtId
Call lstOrte_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

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

If errorhandling Then On Error GoTo fehlerbehandlung

lstOrte = Null
DoCmd.GoToRecord , , acNewRec
txtBezeichnung.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstOrte.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtBezeichnung_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgeführt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelöscht wird!
' Das Drücken der Esc-Taste bewirkt, dass ein gelöschter 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 drücken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmOrte_ufoLager"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtLager_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmLager", , , , , , Me!lager_id
End Sub


'***************************************************************
'***************************************************************
"Form_frmRueckgabe"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Anzeige des ersten Datensatzes in der Liste

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

Me!lstPersonen.SetFocus
If Nz(lstPersonen.ListCount) > 0 Then   ' erste Zeile auswählen
   Me!lstPersonen = Me!lstPersonen.ItemData(0)
   Call lstPersonen_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtBemerkung_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtName_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtVorname_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub lstPersonen_AfterUpdate()
'--------------------------------------------------------------
'In der Liste ausgewählten Datensatz anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstPersonen) Then Me.Recordset.FindFirst "per_id=" & Me!lstPersonen

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

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

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Eine Person löschen

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

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde ein zu löschender Datensatz ausgewählt?
If IsNull(lstPersonen) Then
   MsgBox "Bitte wählen Sie die zu löschende Person aus der Liste!"
   lstPersonen.SetFocus
   Exit Sub
End If

If Nz(Me!txtVorname) = "" Then
   strPervorname = ""
Else
   strPervorname = Me!txtVorname
End If

strMsgtext = "Wollen Sie " & strPervorname & " " & Me!txtName & " wirklich löschen?"

'Gibt es noch Datensätze in anderen Tabellen, die mit dem zu löschenden
'Datensatz in Beziehung stehen ?

Set rs = CurrentDb.OpenRecordset("tblAusleihe", dbOpenDynaset)
rs.FindFirst "per_id_f=" & Str(Me!per_id)

If rs.NoMatch Then
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   rs.Close
   Set rs = Nothing
   If lngAntwort = vbNo Then Exit Sub
   CurrentDb.Execute "DELETE FROM tblKontakt WHERE per_id_f=" & Str(Me!per_id)
   CurrentDb.Execute "DELETE FROM tblPerson WHERE per_id=" & Str(Me!per_id)
   lstPersonen.Requery
   Requery
   Me!lstPersonen.SetFocus
   
   If Nz(lstPersonen.ListCount) > 0 Then   ' erste Zeile auswählen
      Me!lstPersonen = Me!lstPersonen.ItemData(0)
      Call lstPersonen_AfterUpdate
   End If
   
Else
   MsgBox "Diese Person kann nicht gelöscht werden!" & vbCrLf & _
          "Sie hat noch ausgeliehene Bücher."
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

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

DoCmd.RunCommand acCmdSaveRecord   ' Speichern des bearbeiteten Datensatzes
lngPerId = Me!per_id               ' Primärschlüssel merken

lstPersonen.Enabled = True
lstPersonen.Requery                ' Refresh der Auswahlliste
lstPersonen.SetFocus
lstPersonen = lngPerId             ' Anzeige des gespeicherten Datensatzes
Call lstPersonen_AfterUpdate       ' Trick 17: Click-Simulation!!

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

lstPersonen = Null

DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstPersonen.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmRueckgabe_ufoBuecher"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtAusBis_AfterUpdate()
'--------------------------------------------------------------
'Für den Fall, dass gerade nur die offenen Ausleihen angezeigt werden
'und der Nutzer ein Rückgabedatum eingetragen hat, muss das entsprechende
'Buch aus der Liste verschwinden. Darum muss die Liste aktualisiert werden.

If errorhandling Then On Error GoTo fehlerbehandlung

Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Eine Ausleihe löschen

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

If errorhandling Then On Error GoTo fehlerbehandlung

strMsgtext = "Wollen Sie die Ausleihe des Buches" & vbCrLf & _
           Me!txtTitel & vbCrLf & "wirklich löschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

strSQL = "SELECT mahn_id_f FROM tblAus_Mahn WHERE aus_id_f = " & Str(Me!aus_id)
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rs.EOF   ' Löschen aller Mahnungen, die zu der zu löschenden Ausleihe gehören
   lngMahnIdf = rs!mahn_id_f
   rs.Delete   ' Löschen in der Zwischentabelle tblAus_Mahn (=RecordSet!)
   CurrentDb.Execute ("DELETE FROM tblMahnung WHERE mahn_id = " & Str(lngMahnIdf))
   rs.MoveNext
Loop
rs.Close
Set rs = Nothing

CurrentDb.Execute ("DELETE FROM tblAusleihe WHERE aus_id=" & Str(Me!aus_id))
Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
'Beim Öffnen des Formulars wird die Anzeige so eingestellt, dass
'nur die offenen Ausleihen angezeigt werden.

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

lblVon.Caption = "seit:"
lblBis.Caption = "rück:"
tggAlleOffene = 0
tggAlleOffene.Caption = "alle Ausleihen anzeigen"
lblInfotext.Caption = "Sie können jetzt das Datum der Rückgabe eingeben!"
Me.Filter = "tblAusleihe.aus_bis is null"
Me.FilterOn = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub tggAlleOffene_Click()
'--------------------------------------------------------------
'Der Umschaltbutton wechselt die Anzeige zwischen "Nur die offenen Ausleihen"
'und "Alle Ausleihen"

'Der Umschaltbutton muss sich im Unterformular befinden, weil die Anwendung
'eines Filters auf ein Unterformular nicht funktioniert!
'Das geht also NICHT:
'Forms!frmRueckgabe!frmRueckgabe_ufoBuecher.Filter = "tblAusleihe.AUS_BIS is null"

'If umschalt_alleoffene = 0 Then
'   MsgBox "0"
'Else
'   MsgBox "-1"
'End If

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Filter = "tblAusleihe.aus_bis IS NULL"

If tggAlleOffene = 0 Then
'Das bedeutet, es werden nur die offenen Ausleihen angezeit.
   tggAlleOffene.Caption = "alle Ausleihen anzeigen"
   lblInfotext.Caption = "Sie können jetzt das Datum der Rückgabe eingeben!"
   txtAusVon.Locked = True
   txtAusBis.Locked = False
   lblVon.Caption = "seit:"
   lblBis.Caption = "rück:"
   Me.FilterOn = True
Else
'Das bedeutet, es werden alle Ausleihen angezeigt.
   tggAlleOffene.Caption = "nur offene Ausleihen anzeigen"
   lblInfotext.Caption = "Nur zur Ansicht!"
   txtAusVon.Locked = True
   txtAusBis.Locked = True
   lblVon.Caption = "von:"
   lblBis.Caption = "bis:"
   Me.FilterOn = False
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmRueckgabe_ufoKontakte"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cboKontakttyp_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 führen kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.RunCommand (acCmdSaveRecord)

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboKontakttyp_Dirty(Cancel As Integer)
'--------------------------------------------------------------
' Sicherheitsmaßnahme gegen versehentliches Ändern von Daten durch
' Clicken in ein Kombinationsfeld
' Beim erstmaligen Eintrag von Daten (OldValue=Null) wird nicht nachgefragt.

If errorhandling Then On Error GoTo fehlerbehandlung

If IsNull(cboKontakttyp.OldValue) Then Exit Sub
If MsgBox("Wollen Sie den Kontakttyp wirklich ändern?", vbYesNo + vbDefaultButton2) = vbNo Then _
   Cancel = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cboKontakttyp_GotFocus()
'--------------------------------------------------------------
' Wenn der Inhalt der Combobox in einem anderen Formular geändert wurde,
' soll die Änderung hier sofort sichtbar werden

If errorhandling Then On Error GoTo fehlerbehandlung

cboKontakttyp.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Einen Kontakt löschen

Dim strMsgtext As String
Dim lngAntwort As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'In der letzten Zeile kann ein neuer Kontakt eingegeben werden.
'Dort darf nicht gelöscht werden.

If IsNull(txtKontakt) Then Exit Sub

'Sicherheitsabfrage

strMsgtext = "Wollen Sie den Kontakt" & vbCrLf & _
           Me!txtKontakt & vbCrLf & "wirklich löschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

CurrentDb.Execute ("DELETE FROM tblKontakt WHERE kon_id=" & Str(Me!kon_id))
Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
' Mit dem folgenden Befehl wird verhindert, dass sich die Standardwarnung
' "Sie sind dabei, 1 Datensätze zu löschen ..." zusätzlich zu der selbst programmierten
' Warnung in Form_Delete auch noch öffnet!

If errorhandling Then On Error GoTo fehlerbehandlung

Response = acDataErrContinue

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(txtKontakt) = "" Then
   MsgBox "Bitte geben Sie die Kontaktdaten ein!"
   txtKontakt.SetFocus
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Delete(Cancel As Integer)
'--------------------------------------------------------------
' Diese Prozedur wird ausgeführt, wenn im Formular ein Datensatz ausgewählt und
' auf "Entf." gedrückt wird - aber noch BEVOR das eigentliche Löschen erfolgt.
' Indem man den Parameter "Cancel" auf True setzt, kann man das Löschen verhindern.

If errorhandling Then On Error GoTo fehlerbehandlung

If MsgBox("Wollen Sie den Kontakt wirklich löschen?", vbYesNo + _
           vbDefaultButton2) = vbNo Then Cancel = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
Me.Cycle = 1
End Sub


'***************************************************************
'***************************************************************
"Form_frmSachgebiete"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cmdKopieren_Click()
'--------------------------------------------------------------
'Der Name des aktuellen Sachgebietes wird in das Textfeld mit dem
'neuen Sachgebiet übernommen. Damit spart man sich das Eintippen,
'wenn man einen Teilbaum umhängen will.

If errorhandling Then On Error GoTo fehlerbehandlung

txtNeuesUntersachgebiet = txtSachgebiet
txtNeuesUntersachgebiet.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
' Ein Sachgebiet löschen

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

If errorhandling Then On Error GoTo fehlerbehandlung

' Das oberste Sachgebiet darf nicht gelöscht werden!

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"
strOberstesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

If Me!txtSachgebiet = strOberstesSachgebiet Then
 MsgBox "Das oberste Sachgebiet darf nicht gelöscht werden!"
 Exit Sub
End If

' Gibt es noch Bücher, die zu dem zu löschenden Sachgebiet gehören?
Set rs = CurrentDb.OpenRecordset("tblBuch_Sach", dbOpenDynaset)
rs.FindFirst "sachgebiet='" & Me!SACHGEBIET & "'"
If rs.NoMatch Then
  rs.Close
  Set rs = Nothing
Else
  MsgBox "Dieses Sachgebiet kann nicht gelöscht werden," & vbCrLf & _
         "weil es dazu noch Bücher gibt!"
  rs.Close
  Set rs = Nothing
  Exit Sub
End If

' Hat das zu löschende Sachgebiet noch Untersachgebiete?
' (Oder, mit anderen Worten: Ist es noch irgendwo Obersachgebiet?)

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "obersachgebiet='" & Me!txtSachgebiet & "'"
If rs.NoMatch Then
   strMsgtext = "Wollen Sie das Sachgebiet " & vbCrLf & Me!txtSachgebiet & vbCrLf & "wirklich löschen ?"
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   If lngAntwort = vbYes Then
      CurrentDb.Execute ("DELETE FROM tblSachgebiet WHERE sachgebiet='" & Me!txtSachgebiet & "'")
      Forms!frmSachgebiete.Requery
      Forms!frmSachgebiete!lstSachgebiete.Requery
      Forms!frmSachgebiete!frmSachgebiete_ufoUntersachgebiete.Requery
      rs.Close
      Set rs = Nothing

      ' Zurück zum obersten Sachgebiet
      Set rs = Me.Recordset.Clone
      rs.FindFirst "sachgebiet = '" & strOberstesSachgebiet & "'"
      If Not rs.EOF Then Me.Bookmark = rs.Bookmark
      rs.Close
      Set rs = Nothing
      
   Else
      rs.Close
      Set rs = Nothing
      Exit Sub
   End If
Else
   rs.Close
   Set rs = Nothing
   MsgBox "Dieses Sachgebiet kann nicht gelöscht werden," & vbCrLf & _
          "weil es noch Untersachgebiete hat!"
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
' Hinzufügen eines neuen Untersachgebietes

Dim rs As DAO.Recordset
Dim strAktuellesSachgebiet As String
Dim lngRecordNumber As Long
Dim lngAntwort As Long

If errorhandling Then On Error GoTo fehlerbehandlung

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If Nz(txtNeuesUntersachgebiet) = "" Then
   MsgBox "Bitte geben Sie ein neues Untersachgebiet ein!"
   txtNeuesUntersachgebiet.SetFocus
   Exit Sub
End If

If txtNeuesUntersachgebiet = txtSachgebiet Then
   MsgBox "Ein Sachgebiet kann nicht sich selbst untergeordnet werden!"
   txtNeuesUntersachgebiet = ""
   txtNeuesUntersachgebiet.SetFocus
   Exit Sub
End If

'Sicherheitsabfrage

lngAntwort = MsgBox("Wollen Sie wirklich dem Sachgebiet" & vbCrLf & _
                 "   " & txtSachgebiet & vbCrLf & "das neue Untersachgebiet" & _
                 vbCrLf & "   " & txtNeuesUntersachgebiet & vbCrLf & "hinzufügen?", _
                 vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

' Am Ende der Prozedur muss ein requery aufgerufen werden.
' Daraufhin wird aber der erste Datensatz aus der Tabelle tblSachgebiet angezeigt.
' Damit nach dem requery aber wieder der jetzige aktuelle Datensatz angezeigt wird,
' merke ich mir diesen Datensatz, um nach dem requery hierher zurückkehren zu können!

strAktuellesSachgebiet = Me!txtSachgebiet

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet='" & Me!txtSachgebiet & "'"

' Jetzt wird nach dem hinzuzufügenden Sachgebiet gesucht.

rs.MoveFirst
rs.FindFirst "sachgebiet='" & txtNeuesUntersachgebiet & "'"

' Wird es nicht gefunden, wird es hinzugefügt und dem aktuellen Sachgebiet untergeordnet.
' Wird es gefunden, so wird es dem aktuellen Sachgebiet untergeordnet.
' Achtung: Damit wird der ganze Teilbaum unterhalb des hinzuzufügenden Sachgebietes "umgehängt"!

If rs.NoMatch Then
  rs.AddNew
  rs!SACHGEBIET = Me!txtNeuesUntersachgebiet
  rs!OBERSACHGEBIET = Me!txtSachgebiet
  rs.Update
  rs.Close
  Set rs = Nothing
Else
  rs.Edit   ' Freigabe für die Bearbeitung
  rs!OBERSACHGEBIET = Me!txtSachgebiet   ' Bearbeitung
  rs.Update   ' Speichern des neuen Wertes
  rs.Close    ' Ende der Bearbeitung
  Set rs = Nothing  ' Löschen des Recordsets
End If

Forms!frmSachgebiete.Requery
Forms!frmSachgebiete!lstSachgebiete.Requery
Forms!frmSachgebiete!frmSachgebiete_ufoUntersachgebiete.Requery

' Zurück zum anfänglich angezeigten Sachgebiet

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = '" & strAktuellesSachgebiet & "'"
lngRecordNumber = rs.AbsolutePosition + 1
' AbsolutePosition liefert Null für den ersten Datensatz - darum + 1 !
DoCmd.GoToRecord acDataForm, "frmSachgebiete", acGoTo, lngRecordNumber

' Es geht auch so:
'-------------------
'Set rst = Me.Recordset.Clone
'rst.FindFirst "sachgebiet = '" & aktuelles_sachgebiet & "'"
'If Not rst.EOF Then Me.Bookmark = rst.Bookmark
'rst.Close
'-------------------
' ABER: Das funktioniert NICHT MEHR nach der Aufteilung der Datei
'       in Front- und Backend, d.h. Bookmark funktioniert nicht für
'       eingebundene Tabellen.

Me!txtNeuesUntersachgebiet = ""

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdObersachgebiet_Click()
'--------------------------------------------------------------
' Mache das Obersachgebiet des aktuellen Sachgebietes zum aktuellen Sachgebiet
' (Oder, mit anderen Worten: Gehe im Sachgebietsbaum einen Schritt zurück)

Dim rs As DAO.Recordset

If errorhandling Then On Error GoTo fehlerbehandlung

Set rs = Me.Recordset.Clone
rs.FindFirst "sachgebiet='" & Me!OBERSACHGEBIET & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing

txtSachgebiet.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdOberstesSachgebiet_Click()
'--------------------------------------------------------------
' Zurück zum obersten Sachgebiet

Dim rs As DAO.Recordset
Dim strOberstesSachgebiet As String

If errorhandling Then On Error GoTo fehlerbehandlung

' Finde das oberste Sachgebiet, d.h. das Sachgebiet, für das
' sachgebiet = obersachgebiet ist

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"
strOberstesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

' Mache das oberste Sachgebiet zum aktuellen Sachgebiet

Set rs = Me.Recordset.Clone
rs.FindFirst "sachgebiet = '" & strOberstesSachgebiet & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing

txtSachgebiet.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, 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, vbCritical

End Sub

Private Sub cmdAendern_Click()
'--------------------------------------------------------------
' Den Namen eines vorhandenen Sachgebietes ändern

If errorhandling Then On Error GoTo fehlerbehandlung

If Nz(txtSachgebiet) = "" Then
   MsgBox "Bitte geben Sie ein Sachgebiet ein!"
   txtSachgebiet.Value = txtSachgebiet.OldValue
   txtSachgebiet.SetFocus
   Exit Sub
End If

If DCount("buchsach_id", "tblBuch_Sach", "sachgebiet='" & txtSachgebiet.OldValue & "'") > 0 Then
   MsgBox "Der Name dieses Sachgebietes kann nicht mehr geändert werden," & vbCrLf & _
          "weil es bereits Büchern zugeordnet wurde!"
   txtSachgebiet.Value = txtSachgebiet.OldValue
   Me.Undo
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lstSachgebiete.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
'Zeige nach dem Öffnen das oberste Sachgebiet an!

Dim rs As DAO.Recordset
Dim strOberstesSachgebiet As String

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

'Finde das oberste Sachgebiet

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"

If rs.NoMatch Then
   MsgBox "Es gibt kein Sachgebiet, bei dem sachgebiet=obersachgebiet ist" & vbCrLf & _
          "(oberstes Sachgebiet). Bitte legen Sie ein solches Sachgebiet an," & vbCrLf & _
          "sonst wird dieses Formular nicht funktionieren!"
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

strOberstesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

' ... oder auch so:
' oberstes_sachgebiet = DLookup("sachgebiet", "tblSachgebiet", "sachgebiet=obersachgebiet")
' Achtung: oberstes_sachgebiet muss dann vom Typ Variant sein!

Set rs = Me.Recordset.Clone
rs.FindFirst "sachgebiet = '" & strOberstesSachgebiet & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstSachgebiete) Then Me.Recordset.FindFirst "sachgebiet='" & Me!lstSachgebiete & "'"

txtSachgebiet.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtNeuesUntersachgebiet_GotFocus()
cmdSpeichern.Enabled = True
cmdAendern.Enabled = False
cmdLoeschen.Enabled = False
End Sub

Private Sub txtSachgebiet_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgeführt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelöscht wird!
' Das Drücken der Esc-Taste bewirkt, dass ein gelöschter 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!txtSachgebiet) = "" Then
   MsgBox "Bitte geben Sie einen Sachgebietsnamen ein oder drücken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtSachgebiet_GotFocus()

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Enabled = False
cmdAendern.Enabled = True
cmdLoeschen.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmSachgebiete_ufoUntersachgebiete"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtSachgebiet_Click()
'--------------------------------------------------------------
'Mache das angeclickte Untersachgebiet zum aktuellen Sachgebiet

Dim lngRecordNumber As Long
Dim rs As DAO.Recordset

If errorhandling Then On Error GoTo fehlerbehandlung

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = '" & Me!SACHGEBIET & "'"
lngRecordNumber = rs.AbsolutePosition + 1
' AbsolutePosition liefert Null für den ersten Datensatz !
' Darum + 1 !
' MsgBox Str(lngRecordNumber)

DoCmd.GoToRecord acDataForm, "frmSachgebiete", acGoTo, lngRecordNumber

rs.Close
Set rs = Nothing
Forms!frmSachgebiete!txtSachgebiet.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub



'***************************************************************
'***************************************************************
"Form_frmSpaltenFuellen"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cmdStart_Click()

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 könnte 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
' (standardmäßig 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 Füllen
' nicht mehr um den konkreten Namen der Spalte zu kümmern und kann
' einfach schreiben "rs!fuellspalte"

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

' Jeweils EINEN Fülltext in jede zu füllende 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   ' nächste Zeile in tblFuelltext
   If lngZeile > lngAnzahlZeilen Then lngZeile = 1   ' ggf. von vorne beginnen
   rs.MoveNext
Loop

' Jeweils ZWEI Fülltexte in jede zu füllende 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   ' nächste 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   ' nächste 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, 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


'***************************************************************
'***************************************************************
"Form_frmStart"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub cmdAusleihe_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmAusleihe"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, 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 schließen?", _
          vbYesNo + vbDefaultButton2) = vbYes Then DoCmd.Quit
Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdBuecherSuchen_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmBuechersuche"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
'Zeige die Versionsnummer an

Dim rs As DAO.Recordset

If errorhandling Then On Error GoTo fehlerbehandlung

' Holen der Versionsnummer aus der Tabelle DBinfo

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

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdAutoren_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmAutoren"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdVerlage_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmVerlage"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdRueckgabe_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmRueckgabe"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdOrte_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmOrte"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdLager_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmLager"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdSachgebiete_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmSachgebiete"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdBuecher_Click()
'--------------------------------------------------------------

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmBuecher"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub




'***************************************************************
'***************************************************************
"Form_frmVerlage"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Anzeige des ersten Datensatzes in der Liste

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Cycle = 1

Me!lstVerlage.SetFocus
If Nz(lstVerlage.ListCount) > 0 Then   ' erste Zeile auswählen
   Me!lstVerlage = Me!lstVerlage.ItemData(0)
   Call lstVerlage_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtBemerkung_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtName_BeforeUpdate(Cancel As Integer)
' Ist das Eingabefeld leer?
' Cancel = True bewirkt, dass das Update NICHT ausgeführt wird,
' was in diesem Fall bedeutet, dass der Inhalt des Eingabefeldes
' nicht gelöscht wird!
' Das Drücken der Esc-Taste bewirkt, dass ein gelöschter 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 drücken Sie die Esc-Taste!"
   Cancel = True
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtName_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub txtOrt_Change()
'--------------------------------------------------------------
'Wenn der Nutzer eine Eingabe gemacht hat, soll der
'Speichern-Button zum Standard-Button werden.
'Das bedeutet, der Nutzer kann nach der Dateneingabe
'einfach die Enter-Taste drücken.

If errorhandling Then On Error GoTo fehlerbehandlung

cmdSpeichern.Default = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub lstVerlage_AfterUpdate()
'--------------------------------------------------------------
'Den in der Liste ausgewählten Datensatz anzeigen

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstVerlage) Then Me.Recordset.FindFirst "ver_id=" & Me!lstVerlage

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdStart_Click()
'--------------------------------------------------------------
' Öffnen des Startformulars

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.OpenForm "frmStart"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

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

If errorhandling Then On Error GoTo fehlerbehandlung

DoCmd.Close

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub
Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
'Einen Verlag löschen
' (alternative Technik in frmOrte!)

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

If errorhandling Then On Error GoTo fehlerbehandlung

'Wurde ein zu löschender Datensatz ausgewählt?

If IsNull(lstVerlage) Then
   MsgBox "Bitte wählen Sie den zu löschenden Verlag aus der Liste!"
   lstVerlage.SetFocus
   Exit Sub
End If

strMsgtext = "Wollen Sie den Verlag " & Me!VER_NAME & " wirklich löschen?"

'Gibt es noch Datensätze in anderen Tabellen, die mit dem zu löschenden
'Datensatz in Beziehung stehen ?

Set rs = CurrentDb.OpenRecordset("tblBuch", dbOpenDynaset)
rs.FindFirst "ver_id_f=" & Str(Me!ver_id)

If rs.NoMatch Then
   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   If lngAntwort = vbYes Then
      CurrentDb.Execute "DELETE FROM tblVerlag WHERE ver_id=" & Str(Me!ver_id)
      lstVerlage.Requery
      Requery

      Me!lstVerlage.SetFocus
      If Nz(lstVerlage.ListCount) > 0 Then   ' erste Zeile auswählen
         Me!lstVerlage = Me!lstVerlage.ItemData(0)
         Call lstVerlage_AfterUpdate
      End If
      
   End If
Else
   MsgBox "Dieser Verlag kann nicht gelöscht werden!" & vbCrLf & _
          "Es gibt noch Bücher von ihm."
End If

rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

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

'Hat der Nutzer alle erforderlichen Daten eingegeben?

If errorhandling Then On Error GoTo fehlerbehandlung

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

' Gibt es diesen Verlag schon?

If txtName <> txtName.OldValue And _
   DCount("ver_id", "tblVerlag", "ver_name='" & txtName & "'") > 0 Then
   MsgBox ("Diesen Verlag gibt es schon!")
   Me.Undo   ' Abbrechen der begonnenen Transaktion (Datensatzmarkierer beobachten!!)
   txtName.SetFocus
   Exit Sub
End If

DoCmd.RunCommand acCmdSaveRecord
lngVerId = Me!ver_id

lstVerlage.Enabled = True
lstVerlage.Requery
lstVerlage.SetFocus

' Anzeige des gespeicherten Verlages

lstVerlage = lngVerId
Call lstVerlage_AfterUpdate

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

lstVerlage = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdLoeschen.Enabled = False
cmdNeu.Enabled = False
lstVerlage.Enabled = False

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmVerlage_ufoBuecher"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtBuch_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmBuecher", , , , , , Me!buch_id
End Sub

Private Sub txtLager_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmLager", , , , , , Me!lager_id
End Sub

Private Sub txtOrt_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmOrte", , , , , , Me!ort_id
End Sub


'***************************************************************
'***************************************************************
"Form_frmZuweisung"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

'Dieses Formular kann nicht alleine, sondern nur vom Formular
'"Bücher erfassen" aus geöffnet werden.

Private Sub cmdDazu_Click()
'--------------------------------------------------------------
'Füge ein Sachgebiet zu dem Buch hinzu

If errorhandling Then On Error GoTo fehlerbehandlung

Dim vntVorhanden As Variant

vntVorhanden = DCount("buch_id_f", "tblBuch_Sach", "buch_id_f=" & OpenArgs & _
                   " and sachgebiet='" & Me!txtSachgebiet & "'")
If vntVorhanden > 0 Then Exit Sub

CurrentDb.Execute ("INSERT INTO tblBuch_Sach(sachgebiet, buch_id_f) VALUES ('" & _
                   Me!txtSachgebiet & "'," & OpenArgs & ")")
Forms!frmZuweisung!frmZuweisung_ufoZugewiesen.Requery
Forms!frmBuecher!frmBuecher_ufoSachgebiete.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strDateiname As String
Dim objFso As Object

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

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

If Application.version < "12.0" Then     ' Access 2000/2003
   strDateiname = strDateiname & ".txt"
Else                                     ' Access 2007
   strDateiname = strDateiname & ".rtf"
End If

Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(strDateiname) Then
   DoCmd.OpenForm "Hilfe", , , , , , strDateiname
Else
   MsgBox "Für dieses Formular existiert leider keine Hilfe-Information."
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdObersachgebiet_Click()
'--------------------------------------------------------------
' Mache das Obersachgebiet des aktuellen Sachgebietes zum aktuellen Sachgebiet
' (Oder, mit anderen Worten: Gehe im Sachgebietsbaum einen Schritt zurück)

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset

Set rs = Me.Recordset.Clone
rs.FindFirst "sachgebiet='" & Me!OBERSACHGEBIET & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub cmdOberstesSachgebiet_Click()
'--------------------------------------------------------------
' Zurück zum obersten Sachgebiet

If errorhandling Then On Error GoTo fehlerbehandlung

Dim rs As DAO.Recordset
Dim strOberstesSachgebiet As String

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"
strOberstesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

Set rs = Me.Recordset.Clone
rs.FindFirst "sachgebiet = '" & strOberstesSachgebiet & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, 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, vbCritical

End Sub

Private Sub cmdWeg_Click()
'--------------------------------------------------------------
'Entferne die Zuordnung eines Sachgebietes zu einem Buch

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strSachgebiet As String

strSachgebiet = Forms!frmZuweisung!frmZuweisung_ufoZugewiesen!txtSachgebiet

CurrentDb.Execute ("DELETE FROM tblBuch_Sach WHERE sachgebiet='" & strSachgebiet & _
                   "' and buch_id_f=" & OpenArgs)
Forms!frmZuweisung!frmZuweisung_ufoZugewiesen.Requery
Forms!frmBuecher!frmBuecher_ufoSachgebiete.Requery

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
Dim rs As DAO.Recordset
Dim strOberstesSachgebiet As String

'Dieses Formular kann nicht unabhängig geöffnet werden, sondern nur
'vom Formular "Bücher" aus durch Click auf den Button "Sachgebiete".
'Dabei wird als Öffnungsargument buch_id übegeben.
'Dieses wird verwendet, um den Buchtitel anzuzeigen, dem Sachgebiete
'zugewiesen werden sollen.

If errorhandling Then On Error GoTo fehlerbehandlung

txtBuchtitel = DLookup("buch_titel", "tblBuch", "buch_id=" & OpenArgs)

'Zeige nach dem Öffnen das oberste Sachgebiet an!

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = obersachgebiet"

If rs.NoMatch Then
   MsgBox "Es gibt kein Sachgebiet, bei dem sachgebiet=obersachgebiet ist" & vbCrLf & _
          "(oberstes Sachgebiet). Bitte legen Sie ein solches Sachgebiet an," & vbCrLf & _
          "sonst wird dieses Formular nicht funktionieren!"
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

strOberstesSachgebiet = rs!SACHGEBIET
rs.Close
Set rs = Nothing

' ... oder auch so:
' strOberstesSachgebiet = DLookup("sachgebiet", "tblSachgebiet", "sachgebiet = obersachgebiet")
' Achtung: strOberstesSachgebiet muss dann vom Typ Variant sein!

Set rs = Me.Recordset.Clone
rs.FindFirst "sachgebiet = '" & strOberstesSachgebiet & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

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

If errorhandling Then On Error GoTo fehlerbehandlung

If Not IsNull(lstSachgebiete) Then Me.Recordset.FindFirst "sachgebiet='" & Me!lstSachgebiete & "'"

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmZuweisung_ufoUntersachgebiete"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub txtSachgebiet_Click()
'--------------------------------------------------------------
'Mache das angeclickte Untersachgebiet zum aktuellen Sachgebiet

If errorhandling Then On Error GoTo fehlerbehandlung

Dim lngRecordNumber As Long
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("tblSachgebiet", dbOpenDynaset)
rs.FindFirst "sachgebiet = '" & Me!txtSachgebiet & "'"
lngRecordNumber = rs.AbsolutePosition + 1
' AbsolutePosition liefert Null für den ersten Datensatz !
' Darum + 1 !
' MsgBox Str(lngRecordNumber)

DoCmd.GoToRecord acDataForm, "frmZuweisung", acGoTo, lngRecordNumber

rs.Close
Set rs = Nothing
Parent!txtSachgebiet.SetFocus

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub


'***************************************************************
'***************************************************************
"Form_frmZuweisung_ufoZugewiesen"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
'Es sollen nur die dem Buch bereits zugewiesenen Sachgebiete
'angezeigt werden.

'OpenArgs wird beim Öffnen des Formulars "Zuweisung" übergeben
'und enthält die buch_id des Buches, dem Sachgebiete zugewiesen
'werden sollen.

'MsgBox Parent.OpenArgs

If errorhandling Then On Error GoTo fehlerbehandlung

Me.Filter = "buch_id_f = " & Parent.OpenArgs
Me.FilterOn = True

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub



'***************************************************************
'***************************************************************
"Hilfsprozeduren"
'***************************************************************
'***************************************************************

Option Compare Database
Option Explicit

Public Function eigene_MFL_laden()
' Der Wert der Konstanten "Accessversion" wird so gesetzt:
' In VBA: Extras / Eigenschaften von ...
' Dort unter "Argumente für die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so müssen 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 "ausleihe"
      DoCmd.OpenForm "frmAusleihe"
   Case "personen"
      DoCmd.OpenForm "frmRueckgabe"

   Case "erfassen"
      DoCmd.OpenForm "frmBuecher"
   Case "suchen"
      DoCmd.OpenForm "frmBuechersuche"

   Case "autoren"
      DoCmd.OpenForm "frmAutoren"
   Case "sachgebiete"
      DoCmd.OpenForm "frmSachgebiete"
   Case "verlage"
      DoCmd.OpenForm "frmVerlage"
   Case "orte"
      DoCmd.OpenForm "frmOrte"
   Case "lager"
      DoCmd.OpenForm "frmLager"
   Case Else
      MsgBox "OnButtonClick: Unbekannter Formularname!"

End Select
End Sub
#End If

Public Function errorhandling() As Boolean
errorhandling = False
End Function

Public Function FormIsOpen(strFormname As String) As Boolean
Dim frm As Form

FormIsOpen = False
For Each frm In Forms
   If frm.Name = strFormname Then FormIsOpen = True
Next frm

End Function

Public Function sqldatum(datNormaldatum As Date) As String

' Umwandlung eines Datums in das Format, das in SQL-Anweisungen benötigt wird,
' also z.B. #03/25/2008# statt 25.3.2008

sqldatum = "#" & Month(datNormaldatum) & "/" & Day(datNormaldatum) & "/" & Year(datNormaldatum) & "#"
End Function

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

If errorhandling Then On Error GoTo fehlerbehandlung

Dim strDateiname As String
Dim fso As Object

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

' In Access 2003 können 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 für die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so müssen 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 "Für dieses Formular existiert leider keine Hilfe-Information."
End If

Exit Sub
fehlerbehandlung:
   MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical

End Sub

