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

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

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

If Not IsNull(Liste15) Then Me.Recordset.FindFirst "kauf_id=" & Me!Liste15

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

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

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Auftrag " & Me!txtNummer & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mat WHERE kauf_id_f=" & Str(Me!kauf_id)
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE kauf_id_f=" & Str(Me!kauf_id)
   CurrentDb.Execute "DELETE FROM tblKundenauftrag WHERE kauf_id=" & Str(Me!kauf_id)
   Liste15.Requery   ' AKTUALISIEREN DER LISTE!!
   Requery                ' Aktualisieren des Formulars
   Liste15.SetFocus
   If Nz(Liste15.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!Liste15 = Me!Liste15.ItemData(0)
      Call Liste15_AfterUpdate
   End If
End If

End Sub

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

Liste15 = Null

DoCmd.GoToRecord , , acNewRec
cboKunde.SetFocus

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfragen

If Nz(txtBeschreibung) = "" Then
   MsgBox "Bitte geben Sie eine Beschreibung des Auftrages ein!"
   txtBeschreibung.SetFocus
   Exit Sub
End If
If IsNull(cboKunde) Then
   MsgBox "Bitte whlen Sie einen Kunden aus!"
   cboKunde.SetFocus
   Exit Sub
End If
If IsNull(cboAuftragsstatus) Then
   MsgBox "Bitte whlen Sie einen Status aus!"
   cboAuftragsstatus.SetFocus
   Exit Sub
End If
If Nz(txtNummer) = "" Then
   MsgBox "Bitte geben Sie eine Auftragsnummer ein!"
   txtNummer.SetFocus
   Exit Sub
End If

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngKaufId = Me!kauf_id

' AKTUALISIEREN DER LISTE!!

Liste15.Enabled = True
Liste15.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

Liste15.SetFocus
Liste15 = lngKaufId
Call Liste15_AfterUpdate

End Sub

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

Me!Liste15.SetFocus
If Nz(Liste15.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!Liste15 = Me!Liste15.ItemData(0)
   Call Liste15_AfterUpdate
End If

End Sub


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

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

' Wenn es noch Auftrge von dem zu lschenden Kunden gibt,
' kann er nicht gelscht werden!

If DCount("kauf_id", "tblKundenauftrag", "kun_id_f=" & Str(Me!kun_id)) > 0 Then
   MsgBox "Der Kunde kann nicht gelscht werden. Es gibt noch Auftrge von ihm!"
   Exit Sub
End If

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(Liste11) Then
   MsgBox "Bitte whlen Sie den zu lschenden Kunden aus der Liste!"
   Liste11.SetFocus
   Exit Sub
End If

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Kunden " & Me!txtVorname & " " & Me!txtName & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKontakt WHERE kun_id_f=" & Str(Me!kun_id)
   CurrentDb.Execute "DELETE FROM tblKunde WHERE kun_id=" & Str(Me!kun_id)
   Liste11.Requery   ' Aktualisieren der Liste
   Requery             ' Aktualisieren des Formulars
   Liste11.SetFocus
   If Nz(Liste11.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!Liste11 = Me!Liste11.ItemData(0)
      Call Liste11_AfterUpdate
   End If
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
Liste11 = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfrage

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

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngKunId = Me!kun_id

' Aktualisieren der Kundenliste

Liste11.Enabled = True
Liste11.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

Liste11.SetFocus
Liste11 = lngKunId
Call Liste11_AfterUpdate

End Sub

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

If Not IsNull(Liste11) Then Me.Recordset.FindFirst "kun_id=" & Me!Liste11

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub


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

Private Sub button_auftragsbearbeitung_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmAuftragsbearbeitung"
End Sub

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

Private Sub button_kunden_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmKunden"
End Sub

Private Sub button_kunden_falsch_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmKunden"
End Sub

Private Sub button_kundenauftraege_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmKundenauftraege"
End Sub

Private Sub button_materialart_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmMaterialart"
End Sub

Private Sub button_mitarbeiter_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmMitarbeiter"
End Sub

Private Sub button_personalplanung_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmPersonalplanung"
End Sub

Private Sub cmdAuftragsbearbeitung1_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt1"
End Sub

Private Sub cmdAuftragsbearbeitung2_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt2"
End Sub

Private Sub cmdAuftragsbearbeitung3_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt3"
End Sub

Private Sub cmdAuftragsbearbeitung4_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt4"
End Sub

Private Sub cmdAuftragsbearbeitung5_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt5"
End Sub

Private Sub cmdAuftragsbearbeitung6_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt6"
End Sub

Private Sub cmdAuftragsbearbeitung7_Click()
DoCmd.OpenForm "frmAuftragsbearbeitungNachSchritt7"
End Sub

Private Sub cmdKunden1_Click()
DoCmd.OpenForm "frmKundenNachSchritt1"
End Sub

Private Sub cmdKunden2_Click()
DoCmd.OpenForm "frmKundenNachSchritt2"
End Sub

Private Sub cmdKunden3_Click()
DoCmd.OpenForm "frmKundenNachSchritt3"
End Sub

Private Sub cmdKunden4_Click()
DoCmd.OpenForm "frmKundenNachSchritt4"
End Sub

Private Sub cmdKunden5_Click()
DoCmd.OpenForm "frmKundenNachSchritt5"
End Sub

Private Sub cmdKunden6_Click()
DoCmd.OpenForm "frmKundenNachSchritt6"
End Sub

Private Sub cmdKunden7_Click()
DoCmd.OpenForm "frmKundenNachSchritt7"
End Sub

Private Sub cmdKundenauftraege1_Click()
DoCmd.OpenForm "frmKundenauftraege1"
End Sub

Private Sub cmdKundenauftraege2_Click()
DoCmd.OpenForm "frmKundenauftraege2"
End Sub

Private Sub cmdKundenauftraege3_Click()
DoCmd.OpenForm "frmKundenauftraege3"
End Sub

Private Sub cmdKundenauftraege4_Click()
DoCmd.OpenForm "frmKundenauftraege4"
End Sub

Private Sub cmdKundenauftraege5_Click()
DoCmd.OpenForm "frmKundenauftraege5"
End Sub

Private Sub cmdKundenauftraege6_Click()
DoCmd.OpenForm "frmKundenauftraege6"
End Sub

Private Sub cmdKundenauftraege7_Click()
DoCmd.OpenForm "frmKundenauftraege7"
End Sub

Private Sub cmdMitarbeiter1_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt1"
End Sub

Private Sub cmdMitarbeiter2_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt2"
End Sub

Private Sub cmdMitarbeiter3_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt3"
End Sub

Private Sub cmdMitarbeiter4_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt4"
End Sub

Private Sub cmdMitarbeiter5_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt5"
End Sub

Private Sub cmdMitarbeiter6_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt6"
End Sub

Private Sub cmdMitarbeiter7_Click()
DoCmd.OpenForm "frmMitarbeiterNachSchritt7"
End Sub

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

' Holen der Versionsnummer aus der Tabelle tblDBINFO

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

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

End Sub


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

Private Sub cmdStart_Click()
Dim lngZeile As Long
Dim lngAnzahlZeilen As Long
Dim strSQL As String
Dim rs As DAO.Recordset
Dim tdef As TableDef
Dim blnGefunden As Boolean
Dim tabspalte As Field

lblFertig.Visible = False

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

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

' Existiert die Zieltabelle?

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

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

' Existiert die Zielspalte?

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

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

' Das knnte lange dauern - darum Anzeige der Sanduhr

DoCmd.Hourglass True

' Wieviele Zeilen hat die Tabelle tblFuelltext?

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

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

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

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

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

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

' Jeweils EINEN Flltext in jede zu fllende Zelle

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

' Jeweils ZWEI Flltexte in jede zu fllende Zelle

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


rs.Close
Set rs = Nothing

DoCmd.Hourglass False
lblFertig.Visible = True

End Sub

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

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

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

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

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

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

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

If Not IsNull(lstAuftraege) Then Me.Recordset.FindFirst "kauf_id=" & Me!lstAuftraege

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

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

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Auftrag " & Me!txtNummer & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mat WHERE kauf_id_f=" & Str(Me!kauf_id)
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE kauf_id_f=" & Str(Me!kauf_id)
   CurrentDb.Execute "DELETE FROM tblKundenauftrag WHERE kauf_id=" & Str(Me!kauf_id)
   lstAuftraege.Requery   ' AKTUALISIEREN DER LISTE!!
   Requery                ' Aktualisieren des Formulars
   lstAuftraege.SetFocus
   If Nz(lstAuftraege.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstAuftraege = Me!lstAuftraege.ItemData(0)
      Call lstAuftraege_AfterUpdate
   End If
End If

End Sub

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

lstAuftraege = Null

DoCmd.GoToRecord , , acNewRec
cboKunde.SetFocus

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfragen

If Nz(txtBeschreibung) = "" Then
   MsgBox "Bitte geben Sie eine Beschreibung des Auftrages ein!"
   txtBeschreibung.SetFocus
   Exit Sub
End If
If IsNull(cboKunde) Then
   MsgBox "Bitte whlen Sie einen Kunden aus!"
   cboKunde.SetFocus
   Exit Sub
End If
If IsNull(cboAuftragsstatus) Then
   MsgBox "Bitte whlen Sie einen Status aus!"
   cboAuftragsstatus.SetFocus
   Exit Sub
End If
If Nz(txtNummer) = "" Then
   MsgBox "Bitte geben Sie eine Auftragsnummer ein!"
   txtNummer.SetFocus
   Exit Sub
End If

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngKaufId = Me!kauf_id

' AKTUALISIEREN DER LISTE!!

lstAuftraege.Enabled = True
lstAuftraege.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

lstAuftraege.SetFocus
lstAuftraege = lngKaufId
Call lstAuftraege_AfterUpdate

End Sub

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

Me!lstAuftraege.SetFocus
If Nz(lstAuftraege.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!lstAuftraege = Me!lstAuftraege.ItemData(0)
   Call lstAuftraege_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub


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

Public Sub public_personalplanung1()
'--------------------------------------------------------------
Call Parent.public_pp_mitarbeiter
End Sub

Public Sub public_lstAuftraege_AfterUpdate()
'--------------------------------------------------------------
' Damit die ...liste_AfterUpdate()-Prozedur von "auen" - also von
' anderen Formularen aus - aufgerufen werden kann, muss eine entspr.
' "Public-Version" definiert werden.

Call lstAuftraege_AfterUpdate
End Sub

Private Sub cboAuftragsstatus_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.
cboAuftragsstatus.Requery

End Sub

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

If Not IsNull(lstAuftraege) Then Me.Recordset.FindFirst "kauf_id=" & Me!lstAuftraege

Parent!txtVon = ""
Parent!txtBis = ""
Parent!txtBemerkung = ""

End Sub

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

Me!lstAuftraege.SetFocus
If Nz(lstAuftraege.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!lstAuftraege = Me!lstAuftraege.ItemData(0)
   Call lstAuftraege_AfterUpdate
End If

Me.Cycle = 1

End Sub

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

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


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

Private Sub cmdAusfuehren_Click()
On Error GoTo fehler

If txtSqlbefehl <> "" Then

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

End If

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



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

Private Sub cmdDruckAlle_Click()
DoCmd.OpenReport "rptKunden", acViewPreview
End Sub

Private Sub cmdDruckEinen_Click()
DoCmd.OpenReport "rptKunden", acViewPreview, , "kun_id=" & Me!kun_id
End Sub

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

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

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

' Wenn es noch Auftrge von dem zu lschenden Kunden gibt,
' kann er nicht gelscht werden!

If DCount("kauf_id", "tblKundenauftrag", "kun_id_f=" & Str(Me!kun_id)) > 0 Then
   MsgBox "Der Kunde kann nicht gelscht werden. Es gibt noch Auftrge von ihm!"
   Exit Sub
End If

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(lstKunden) Then
   MsgBox "Bitte whlen Sie den zu lschenden Kunden aus der Liste!"
   lstKunden.SetFocus
   Exit Sub
End If

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Kunden " & Me!txtVorname & " " & Me!txtName & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKontakt WHERE kun_id_f=" & Str(Me!kun_id)
   CurrentDb.Execute "DELETE FROM tblKunde WHERE kun_id=" & Str(Me!kun_id)
   lstKunden.Requery   ' Aktualisieren der Liste
   Requery             ' Aktualisieren des Formulars
   lstKunden.SetFocus
   If Nz(lstKunden.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstKunden = Me!lstKunden.ItemData(0)
      Call lstKunden_AfterUpdate
   End If
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
lstKunden = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdNeu.Enabled = False
cmdLoeschen.Enabled = False
lstKunden.Enabled = False
cmdDruckEinen.Enabled = False
cmdDruckAlle.Enabled = False

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfrage

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

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngKunId = Me!kun_id

' Aktualisieren der Kundenliste

lstKunden.Enabled = True
lstKunden.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

lstKunden.SetFocus
lstKunden = lngKunId
Call lstKunden_AfterUpdate

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstKunden.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstKunden.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstKunden = Me!lstKunden.ItemData(0)
      Call lstKunden_AfterUpdate
   End If

Else
   Me!lstKunden = OpenArgs
   Call lstKunden_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

End Sub

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

If Not IsNull(lstKunden) Then Me.Recordset.FindFirst "kun_id=" & Me!lstKunden

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

cmdDruckEinen.Enabled = True
cmdDruckAlle.Enabled = True

End Sub

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

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

End Sub

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

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

' Wenn es noch Auftrge von dem zu lschenden Kunden gibt,
' kann er nicht gelscht werden!

If DCount("kauf_id", "tblKundenauftrag", "kun_id_f=" & Str(Me!kun_id)) > 0 Then
   MsgBox "Der Kunde kann nicht gelscht werden. Es gibt noch Auftrge von ihm!"
   Exit Sub
End If

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(lstKunden) Then
   MsgBox "Bitte whlen Sie den zu lschenden Kunden aus der Liste!"
   lstKunden.SetFocus
   Exit Sub
End If

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Kunden " & Me!txtVorname & " " & Me!txtName & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKontakt WHERE kun_id_f=" & Str(Me!kun_id)
   CurrentDb.Execute "DELETE FROM tblKunde WHERE kun_id=" & Str(Me!kun_id)
   lstKunden.Requery   ' Aktualisieren der Liste
   Requery             ' Aktualisieren des Formulars
   lstKunden.SetFocus
   If Nz(lstKunden.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstKunden = Me!lstKunden.ItemData(0)
      Call lstKunden_AfterUpdate
   End If
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
lstKunden = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfrage

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

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngKunId = Me!kun_id

' Aktualisieren der Kundenliste

lstKunden.Enabled = True
lstKunden.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

lstKunden.SetFocus
lstKunden = lngKunId
Call lstKunden_AfterUpdate

End Sub

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

If Not IsNull(lstKunden) Then Me.Recordset.FindFirst "kun_id=" & Me!lstKunden

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub

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

Private Sub Liste15_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[kauf_id] = " & Str(Nz(Me![Liste15], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

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

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

Private Sub cboMengeneinheit_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.
cboMengeneinheit.Requery

End Sub

Private Sub cmdAlle_Click()
'--------------------------------------------------------------
Dim strSQL As String

strSQL = "SELECT mat_id, mat_name FROM tblMaterialart " & _
         "ORDER BY mat_name"
'MsgBox strSQL

txtSuchbegriff = ""

lstMaterialarten.RowSourceType = "Table/Query"
lstMaterialarten.RowSource = strSQL
lstMaterialarten.Requery

If Nz(lstMaterialarten.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!lstMaterialarten = Me!lstMaterialarten.ItemData(0)
   Call lstMaterialarten_AfterUpdate
End If

End Sub

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

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
Dim lngAntwort As Long
Dim strMsgtext As String
Dim rs As DAO.Recordset

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(lstMaterialarten) Then
   MsgBox "Bitte whlen Sie die zu lschende Materialart aus der Liste!"
   lstMaterialarten.SetFocus
   Exit Sub
End If

'Hat der Nutzer NEUEN DATENSATZ EINFGEN gedrckt und
'sofort danach DATENSATZ LSCHEN?

If Nz(Me!txtName) = "" Then
   MsgBox "Bitte whlen Sie die zu lschende Materialart aus der Liste!"
   lstMaterialarten.SetFocus
   Exit Sub
End If

strMsgtext = "Wollen Sie die Materialart " & Me!txtName & " wirklich lschen?"

' Gibt es noch Datenstze in anderen Tabellen, die mit dem zu lschenden
' Datensatz in Beziehung stehen ?
' Wenn es solche Datenstze noch gibt (in diesem Fall sind es Kundenauftrge,
' die die zu lschende Materialart brauchen), wird die Sicherheitsfrage
' "Wollen Sie wirklich ...?" gar nicht erst gestellt.
' Der Nutzer wird vielmehr darber informiert, warum die Lschung
' nicht durchgefhrt werden kann.

Set rs = CurrentDb.OpenRecordset("tblKauf_Mat", dbOpenDynaset)
rs.FindFirst "mat_id_f=" & Str(Me!mat_id)

If rs.NoMatch Then   ' Es kann gelscht werden.

   lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
   rs.Close
   Set rs = Nothing
   If lngAntwort = vbNo Then Exit Sub
   CurrentDb.Execute "DELETE FROM tblMaterialart WHERE mat_id=" & Str(Me!mat_id)
   lstMaterialarten.Requery   ' Aktualisieren der Liste
   Requery                    ' Aktualisieren des Formulars
   lstMaterialarten.SetFocus
   If Nz(lstMaterialarten.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstMaterialarten = Me!lstMaterialarten.ItemData(0)
      Call lstMaterialarten_AfterUpdate
   End If
   
Else   ' Es kann NICHT gelscht werden.

   MsgBox "Diese Materialart kann nicht gelscht werden!" & vbCrLf & _
          "Es gibt noch Auftrge damit."
   rs.Close
   Set rs = Nothing
   Exit Sub
   
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
lstMaterialarten = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdNeu.Enabled = False
cmdLoeschen.Enabled = False
lstMaterialarten.Enabled = False

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

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

DoCmd.RunCommand acCmdSaveRecord
lngMatId = Me!mat_id

lstMaterialarten.Enabled = True
lstMaterialarten.Requery
lstMaterialarten.SetFocus

' Anzeige des gespeicherten Wertes

lstMaterialarten = lngMatId
Call lstMaterialarten_AfterUpdate

End Sub

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

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

Private Sub cmdSuchen_Click()
'--------------------------------------------------------------
' Achtung: Statt nur nach dem Suchbegriff wird nach
'          '*Suchbegriff*' gesucht. Dadurch kann der Nutzer
'          auch Wortbestandteile eingeben.
' Die Suche nach "furnier" liefert also als Ergebnis sowohl
' "Eichenfurnier" als auch "Birkenfurnier" als auch "Buchenfurnier".

Dim strSQL As String

strSQL = "SELECT mat_id, mat_name FROM tblMaterialart " & _
         "WHERE mat_name LIKE '*" & txtSuchbegriff & "*' " & _
         "ORDER BY mat_name"
'MsgBox strSQL

lstMaterialarten.RowSourceType = "Table/Query"
lstMaterialarten.RowSource = strSQL
lstMaterialarten.Requery

If Nz(lstMaterialarten.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!lstMaterialarten = Me!lstMaterialarten.ItemData(0)
   Call lstMaterialarten_AfterUpdate
End If

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstMaterialarten.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstMaterialarten.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstMaterialarten = Me!lstMaterialarten.ItemData(0)
      Call lstMaterialarten_AfterUpdate
   End If

Else
   Me!lstMaterialarten = OpenArgs
   Call lstMaterialarten_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

End Sub

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

If Not IsNull(lstMaterialarten) Then Me.Recordset.FindFirst "mat_id=" & Me!lstMaterialarten

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub

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

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

End Sub

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

Private Sub Liste15_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[kauf_id] = " & Str(Nz(Me![Liste15], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

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 fhren kann,
' wird die gerade begonnene Transaktion auch sofort wieder durch einen
' "Speichern"-Befehl beendet.

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

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

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

End Sub

Private Sub cboKontakttyp_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.
cboKontakttyp.Requery
End Sub

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

' in der letzten Zeile der Liste darf nicht gelscht werden

If IsNull(kon_kontakt) Then Exit Sub

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Kontakt " & Me!kon_kontakt & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKontakt WHERE kon_id=" & Str(Me!kon_id)
   Requery
End If

End Sub

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

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

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

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

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

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

End Sub

Private Sub cboAuftragsstatus_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.

cboAuftragsstatus.Requery

End Sub

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

Private Sub txtBeschreibung_DblClick(Cancel As Integer)
'--------------------------------------------------------------
DoCmd.OpenForm "frmAuftragsbearbeitung", , , , , , Me!kauf_id
End Sub

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

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

' Sicherheitsfrage
strMsgtext = "Wollen Sie diese Zuordnung wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE kauf_id_f=" & _
                     Str(Forms!frmPersonalplanung!frmPersonalplanung1!lstAuftraege) & _
                     " AND mit_id_f=" & _
                     Str(Parent!lstMitarbeiter)
   Forms!frmPersonalplanung!frmPersonalplanung1.Requery
   Forms!frmPersonalplanung!frmPersonalplanung2.Requery
End If

End Sub

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

Private Sub txtBeschreibung_Click()
'--------------------------------------------------------------
' Der Click auf die Auftragsbeschreibung soll diesen Auftrag im Unterformular "frmPersonalplanung1" auswhlen
' und dort aber auch gleich bewirken, dass die zu diesem Auftrag gehrigen Mitarbeiter angezeigt werden.
' Zu diesem Zweck muss ein Click in die Auftragsliste simuliert werden - und zwar durch den Aufruf der
' Prozedur auftragsliste_AfterUpdate.
' Das ist aber nicht so ohne weiteres mglich. Es muss zunchst eine Public Prozedur im bergeordneten
' Formular aufgerufen werden, die wiederum eine Public Prozedur in ihrem bergeordenten Formular aufruft.
' Das ist dann das Startformular "frmPersonalplanung". Die Prozedur dort kann dann letztendlich die Prozedur
' public_auftragsliste_AfterUpdate im Unterformular "frmPersonalplanung1" aufrufen.
' Dass ist ein ziemlicher Irrweg - aber anders habe ich es nicht hingekriegt ...

Forms!frmPersonalplanung!frmPersonalplanung1!lstAuftraege = Me!kauf_id
Forms!frmPersonalplanung!frmPersonalplanung1!lstAuftraege.SetFocus
Call Parent.public_personalplanung2

' Anzeige der Daten, damit sie mittels "Speichern" gendert werden knnen

Parent.Parent!txtVon = Me!txtVon
Parent.Parent!txtBis = Me!txtBis
Parent.Parent!txtBemerkung = Me!txtBemerkung

End Sub

Private Sub txtBeschreibung_DblClick(Cancel As Integer)
DoCmd.OpenForm "frmAuftragsbearbeitung", , , , , , Me!kauf_id
End Sub

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

Private Sub Liste11_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[kun_id] = " & Str(Nz(Me![Liste11], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

Private Sub Liste15_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[kauf_id] = " & Str(Nz(Me![Liste15], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

Private Sub cmdDruckAlle_Click()
DoCmd.OpenReport "rptMitarbeiter", acViewPreview
End Sub

Private Sub cmdDruckEinen_Click()
If IsNull(lstMitarbeiter) Then
   MsgBox "Bitte geben Sie einen Mitarbeiter aus!"
   Exit Sub
End If

DoCmd.OpenReport "rptMitarbeiter", acViewPreview, , "mit_id=" & Me!mit_id
End Sub

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

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

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

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(lstMitarbeiter) Then
   MsgBox "Bitte whlen Sie den zu lschenden Mitarbeiter aus der Liste!"
   lstMitarbeiter.SetFocus
   Exit Sub
End If

' Sicherheitsfrage
' (Dabei ist standardmig der zweite Button ("Nein") aktiviert.
'  Wenn der Nutzer also nach Erscheinen der Sicherheitsfrage einfach
'  nur die Enter-Taste drckt, wird NICHT gelscht!)

strMsgtext = "Wollen Sie den Mitarbeiter " & Me!txtVorname & " " & _
             Me!txtName & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

' ACHTUNG: Das automatische Lschen des Verweises auf den zu lschenden
'          Mitarbeiter in tblKauf_Mit ist nicht ganz unproblematisch!
'          Damit geht die Information verloren, dass ein bestimmter
'          Mitarbeiter - den es JETZT in der Firma nicht mehr gibt -
'          irgendwann in der VERGANGENHEIT einmal bestimmte Auftrge
'          bearbeitet hat!
'          Es knnte ebenso gut sein, dass der zu lschende Mitarbeiter
'          fr in der ZUKUNFT zu erledigende Auftrge eingeplant war.
'          Nach der Lschung des Mitarbeiters ist dann u.U. fr
'          bestimmte Auftrge NIEMAND mehr eingeplant!
'
' Wenn man verhindern will, dass in der Vergangeheit oder fr die Zukunft
' eingeplante Mitarbeiter gelscht werden, muss man vorgehen wie im
' Modul Form_frmMaterialart bei der Lschung von Materialarten oder
' wie im Modul Form_frmKunden bei der Lschung von Kunden!
'    (In diesen beiden Modulen werden zwei unterschiedliche
'    Lsungsvarianten demonstriert!)
' Das heit: Wenn es noch Fremdschlsseleintrge in tblKauf_Mit gibt,
' kann der betreffende Mitarbeiter nicht gelscht werden.

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE mit_id_f=" & Str(Me!mit_id)
   CurrentDb.Execute "DELETE FROM tblMitarbeiter WHERE mit_id=" & Str(Me!mit_id)
   lstMitarbeiter.Requery                                ' Aktualisieren der Liste
   Requery                                               ' Aktualisieren des Formulars
   lstMitarbeiter.SetFocus
   If Nz(lstMitarbeiter.ListCount) > 0 Then              ' Wenn die Liste nach dem Lschen
                                                         ' noch Eintrge enthlt ...
      Me!lstMitarbeiter = Me!lstMitarbeiter.ItemData(0)  ' ... soll die erste Zeile der Liste
      Call lstMitarbeiter_AfterUpdate                    '     angezeigt werden
   End If
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
lstMitarbeiter = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

cmdNeu.Enabled = False
cmdLoeschen.Enabled = False
lstMitarbeiter.Enabled = False
cmdDruckEinen.Enabled = False
cmdDruckAlle.Enabled = False

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfrage

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

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngMitId = Me!mit_id

' Aktualisieren der Kundenliste

lstMitarbeiter.Enabled = True
lstMitarbeiter.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

lstMitarbeiter.SetFocus
lstMitarbeiter = lngMitId
Call lstMitarbeiter_AfterUpdate

End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstMitarbeiter.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstMitarbeiter.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstMitarbeiter = Me!lstMitarbeiter.ItemData(0)
      Call lstMitarbeiter_AfterUpdate
   End If

Else
   Me!lstMitarbeiter = OpenArgs
   Call lstMitarbeiter_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

End Sub

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

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

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True
cmdDruckEinen.Enabled = True
cmdDruckAlle.Enabled = True

End Sub

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

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

End Sub

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

Private Sub Liste11_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[kun_id] = " & Str(Nz(Me![Liste11], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

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

' Sicherheitsfrage
strMsgtext = "Wollen Sie diese Zuordnung wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE kauf_id_f=" & _
                     Str(Parent!lstAuftraege) & _
                     " AND mit_id_f=" & _
                     Str(Forms!frmPersonalplanung!frmPersonalplanung2!lstMitarbeiter)
   Forms!frmPersonalplanung!frmPersonalplanung1.Requery
   Forms!frmPersonalplanung!frmPersonalplanung2.Requery
End If

End Sub

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

Private Sub txtName_Click()
'--------------------------------------------------------------
Dim rs As DAO.Recordset
Dim lngRecordnumber As Long

' Der Click auf den Mitarbeiternamen soll diesen Namen im Unterformular "frmPersonalplanung2" auswhlen
' und dort aber auch gleich bewirken, dass die zu diesem Mitarbeiter gehrigen Auftrge angezeigt werden.
' Zu diesem Zweck muss ein Click in die Mitarbeiterliste simuliert werden - und zwar durch den Aufruf der
' Prozedur mitarbeiterliste_AfterUpdate.
' Das ist aber nicht so ohne weiteres mglich. Es muss zunchst eine Public Prozedur im bergeordneten
' Formular aufgerufen werden, die wiederum eine Public Prozedur in ihrem bergeordenten Formular aufruft.
' Das ist dann das Startformular "frmPersonalplanung". Die Prozedur dort kann dann letztendlich die Prozedur
' public_mitarbeiterliste_AfterUpdate im Unterformular "frmPersonalplanung2" aufrufen.
' Dass ist ein ziemlicher Irrweg - aber anders habe ich es nicht hingekriegt ...

Forms!frmPersonalplanung!frmPersonalplanung2!lstMitarbeiter = Me!mit_id
Forms!frmPersonalplanung!frmPersonalplanung2!lstMitarbeiter.SetFocus
Call Parent.public_personalplanung1

' Anzeige der Daten, damit sie mittels "Speichern" gendert werden knnen

Parent.Parent!txtVon = Me!txtVon
Parent.Parent!txtBis = Me!txtBis
Parent.Parent!txtBemerkung = Me!txtBemerkung

'funktioniert NICHT:
'Forms!frmPersonalplanung!frmPersonalplanung2!mitarbeiterliste.SetFocus
'SendKeys "{UP}"
'SendKeys "{DOWN}"

'funktioniert auch NICHT:
'Set rst = CurrentDb.OpenRecordset("tblMitarbeiter", dbOpenDynaset, dbReadOnly)
'rst.FindFirst "mit_id = " & Str(Me!mit_id)
'recordnumber = rst.AbsolutePosition + 1
' AbsolutePosition liefert Null fr den ersten Datensatz - darum +1 !
'DoCmd.GoToRecord acDataForm, "frmPersonalplanung!frmPersonalplanung2", acGoTo, recordnumber
'rst.Close

'funktioniert auch NICHT:
'Set rst = Forms!frmPersonalplanung!frmPersonalplanung2.Recordset.Clone
'rst.FindFirst "mit_id = " & Str(Me!mit_id)
'If Not rst.EOF Then Forms!frmPersonalplanung!frmPersonalplanung2.Bookmark = rst.Bookmark
'rst.Close

End Sub

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

Private Sub cmdNeu_Click()
On Error GoTo Err_cmdNeu_Click


    DoCmd.GoToRecord , , acNewRec

Exit_cmdNeu_Click:
    Exit Sub

Err_cmdNeu_Click:
    MsgBox Err.Description
    Resume Exit_cmdNeu_Click
    
End Sub
Private Sub cmdSpeichern_Click()
On Error GoTo Err_cmdSpeichern_Click


    DoCmd.RunCommand acCmdSaveRecord

Exit_cmdSpeichern_Click:
    Exit Sub

Err_cmdSpeichern_Click:
    MsgBox Err.Description
    Resume Exit_cmdSpeichern_Click
    
End Sub
Private Sub cmdLoeschen_Click()
On Error GoTo Err_cmdLoeschen_Click


    DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdDeleteRecord

Exit_cmdLoeschen_Click:
    Exit Sub

Err_cmdLoeschen_Click:
    MsgBox Err.Description
    Resume Exit_cmdLoeschen_Click
    
End Sub
Private Sub Liste5_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[mit_id] = " & Str(Nz(Me![Liste5], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

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

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

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

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

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

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

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

Close #1

Set modModules = Application.Modules

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

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

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

      
      End If
      
   Next lngModuleNr
      
Next objObject

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

For Each objObject In CurrentProject.AllModules

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

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

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

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

End Sub

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

Dim FileNr As Long
  
FileNr = FreeFile

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

End Function

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

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

End Sub

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

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

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

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

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

End Sub

Private Sub cboMaterialart_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.
cboMaterialart.Requery

End Sub

Private Sub cmdLoeschen_Click()
Dim strMsgtext As String
Dim lngAntwort As Long
Dim strSQL As String

'In der letzten Zeile kann ein neuer Datensatz eingegeben werden.
'Dort darf nicht gelscht werden.

If IsNull(cboMaterialart) Then Exit Sub

'Sicherheitsfrage

strMsgtext = "Wollen Sie das Material" & vbCrLf & _
           cboMaterialart.Column(1) & vbCrLf & "wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)
If lngAntwort = vbNo Then Exit Sub

strSQL = "DELETE FROM tblKauf_Mat WHERE mat_id_f=" & Str(Me!cboMaterialart) & _
          " AND kauf_id_f=" & Str(Parent!kauf_id)
'MsgBox strSQL
'Exit Sub
CurrentDb.Execute strSQL
Requery

End Sub


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

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

Public Sub public_personalplanung2()
'--------------------------------------------------------------
Call Parent.public_pp_auftraege
End Sub

Public Sub public_lstMitarbeiter_AfterUpdate()
'--------------------------------------------------------------
' Damit die ...liste_AfterUpdate()-Prozedur von "auen" - also von
' anderen Formularen aus - aufgerufen werden kann, muss eine entspr.
' "Public-Version" definiert werden.

Call lstMitarbeiter_AfterUpdate
End Sub

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

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

Parent!txtVon = ""
Parent!txtBis = ""
Parent!txtBemerkung = ""

End Sub

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

Me!lstMitarbeiter.SetFocus
If Nz(lstMitarbeiter.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!lstMitarbeiter = Me!lstMitarbeiter.ItemData(0)
   Call lstMitarbeiter_AfterUpdate
End If

Me.Cycle = 1

End Sub

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

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

Private Sub cmdNeu_Click()
On Error GoTo Err_cmdNeu_Click


    DoCmd.GoToRecord , , acNewRec

Exit_cmdNeu_Click:
    Exit Sub

Err_cmdNeu_Click:
    MsgBox Err.Description
    Resume Exit_cmdNeu_Click
    
End Sub
Private Sub cmdSpeichern_Click()
On Error GoTo Err_cmdSpeichern_Click


    DoCmd.RunCommand acCmdSaveRecord

Exit_cmdSpeichern_Click:
    Exit Sub

Err_cmdSpeichern_Click:
    MsgBox Err.Description
    Resume Exit_cmdSpeichern_Click
    
End Sub
Private Sub cmdLoeschen_Click()
On Error GoTo Err_cmdLoeschen_Click


    DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdDeleteRecord

Exit_cmdLoeschen_Click:
    Exit Sub

Err_cmdLoeschen_Click:
    MsgBox Err.Description
    Resume Exit_cmdLoeschen_Click
    
End Sub
Private Sub Liste5_AfterUpdate()
    ' Den mit dem Steuerelement bereinstimmenden Datensatz suchen.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[mit_id] = " & Str(Nz(Me![Liste5], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


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

Public Sub public_pp_mitarbeiter()
'--------------------------------------------------------------
Call Me.frmPersonalplanung2.Form.public_lstMitarbeiter_AfterUpdate
End Sub

Public Sub public_pp_auftraege()
'--------------------------------------------------------------
Call Me.frmPersonalplanung1.Form.public_lstAuftraege_AfterUpdate
End Sub

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

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

Private Sub cmdSpeichern_Click()
'--------------------------------------------------------------
Dim rs As DAO.Recordset
Dim lngKaufId As Long
Dim lngMitId As Long

lngKaufId = Forms!frmPersonalplanung!frmPersonalplanung1!kauf_id
lngMitId = Forms!frmPersonalplanung!frmPersonalplanung2!mit_id

If Nz(txtVon) = "" Then
   MsgBox "Bitte eine Startzeit eingeben!"
   txtVon.SetFocus
   Exit Sub
End If

If Nz(txtBis) = "" Then
   MsgBox "Bitte eine Endezeit eingeben!"
   txtBis.SetFocus
   Exit Sub
End If

If txtBis < txtVon Then
   MsgBox "Der Beginn muss vor dem Ende liegen!"
   txtVon.SetFocus
   Exit Sub
End If

Set rs = CurrentDb.OpenRecordset("tblKauf_Mit", dbOpenDynaset)
rs.FindFirst "kauf_id_f=" & Str(lngKaufId) & " AND mit_id_f=" & Str(lngMitId)

If rs.NoMatch Then   ' NEUER Eintrag (der Mitarbeiter arbeitet bisher noch nicht fr den Auftrag)
   
   rs.AddNew
   rs!kauf_id_f = lngKaufId
   rs!mit_id_f = lngMitId
   rs!KAUFMIT_VON = txtVon
   rs!KAUFMIT_BIS = txtBis
   rs!KAUFMIT_BEMERKUNG = txtBemerkung
   rs.Update
   Forms!frmPersonalplanung!frmPersonalplanung1.Requery
   Forms!frmPersonalplanung!frmPersonalplanung2.Requery

Else   ' Eintrag NDERN (der Mitarbeiter arbeitet schon fr den Auftrag)
   
   rs.Edit
   rs!KAUFMIT_VON = txtVon
   rs!KAUFMIT_BIS = txtBis
   rs!KAUFMIT_BEMERKUNG = txtBemerkung
   rs.Update
   Forms!frmPersonalplanung!frmPersonalplanung1.Requery
   Forms!frmPersonalplanung!frmPersonalplanung2.Requery

End If

rs.Close
Set rs = Nothing

End Sub

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

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

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

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

Private Sub cmdStartformular_Click()
DoCmd.OpenForm "frmStart"
End Sub

Private Sub button_schliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstKunden.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstKunden.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstKunden = Me!lstKunden.ItemData(0)
      Call lstKunden_AfterUpdate
   End If

Else
   Me!lstKunden = OpenArgs
   Call lstKunden_AfterUpdate
End If

Me.Cycle = 1

End Sub

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

If Not IsNull(lstKunden) Then Me.Recordset.FindFirst "kun_id=" & Me!lstKunden

End Sub


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

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

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

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

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

Private Sub cboAuftragsstatus_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.
cboAuftragsstatus.Requery

End Sub

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

DoCmd.RunCommand (acCmdSaveRecord)

End Sub

Private Sub cboKunde_BeforeUpdate(Cancel As Integer)

If IsNull(cboKunde) Then
   MsgBox "Bitte whlen Sie einen Kunden aus!"
   Cancel = True
End If

End Sub

Private Sub cboKunde_DblClick(Cancel As Integer)

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

'If cboKunde = "" Then
'   MsgBox "Bitte whlen Sie einen Kunden aus!"
'   Cancel = True
'   Exit Sub
'End If

DoCmd.RunCommand (acCmdSaveRecord)

DoCmd.OpenForm "frmKunden", , , , , , Me!cboKunde
End Sub

Private Sub cboKunde_GotFocus()
'--------------------------------------------------------------
' Sicherheitsmanahme: Falls der Inhalt des Kombinationsfedles in einem ANDREREN Formular
'                      gendert wurde, muss es hier aktualisiert werden.
cboKunde.Requery

End Sub

Private Sub cmdDruckEinen_Click()
DoCmd.OpenReport "rptAuftrag", acViewPreview, , "kauf_id=" & Me!kauf_id
End Sub

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

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

If Not IsNull(lstAuftraege) Then Me.Recordset.FindFirst "kauf_id=" & Me!lstAuftraege

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

cmdDruckEinen.Enabled = True

End Sub

Private Sub cmdStartformular_Click()
'--------------------------------------------------------------
DoCmd.OpenForm "frmStart"
End Sub

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

' Sicherheitsfrage

strMsgtext = "Wollen Sie den Auftrag " & Me!txtNummer & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mat WHERE kauf_id_f=" & Str(Me!kauf_id)
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE kauf_id_f=" & Str(Me!kauf_id)
   CurrentDb.Execute "DELETE FROM tblKundenauftrag WHERE kauf_id=" & Str(Me!kauf_id)
   lstAuftraege.Requery   ' AKTUALISIEREN DER LISTE!!
   Requery                ' Aktualisieren des Formulars
   lstAuftraege.SetFocus
   If Nz(lstAuftraege.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstAuftraege = Me!lstAuftraege.ItemData(0)
      Call lstAuftraege_AfterUpdate
   End If
End If

End Sub

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

lstAuftraege = Null

DoCmd.GoToRecord , , acNewRec
txtDatum = Date
cboKunde.SetFocus

' Ein neuer Auftrag muss erst gespeichert werden, bevor
' Material eingegeben werden kann!

Forms!frmAuftragsbearbeitung!frmAuftragsbearbeitung_ufoMaterialart.Locked = True

cmdNeu.Enabled = False
cmdLoeschen.Enabled = False
lstAuftraege.Enabled = False

cmdDruckEinen.Enabled = False

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfragen

If Nz(txtBeschreibung) = "" Then
   MsgBox "Bitte geben Sie eine Beschreibung des Auftrages ein!"
   txtBeschreibung.SetFocus
   Exit Sub
End If
If IsNull(cboKunde) Then
   MsgBox "Bitte whlen Sie einen Kunden aus!"
   cboKunde.SetFocus
   Exit Sub
End If
If IsNull(cboAuftragsstatus) Then
   MsgBox "Bitte whlen Sie einen Status aus!"
   cboAuftragsstatus.SetFocus
   Exit Sub
End If
If Nz(txtNummer) = "" Then
   MsgBox "Bitte geben Sie eine Auftragsnummer ein!"
   txtNummer.SetFocus
   Exit Sub
End If

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngKaufId = Me!kauf_id

' AKTUALISIEREN DER LISTE!!

lstAuftraege.Enabled = True
lstAuftraege.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

lstAuftraege.SetFocus
lstAuftraege = lngKaufId
Call lstAuftraege_AfterUpdate

' Jetzt kann Material eingegeben werden

Forms!frmAuftragsbearbeitung!frmAuftragsbearbeitung_ufoMaterialart.Locked = False

End Sub

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

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

Private Sub Form_Open(Cancel As Integer)
'--------------------------------------------------------------
' Wenn das Formular mittels Doppelclick von einem anderen Formular aus geffnet wird,
' soll der dort angeclickte Datensatz angezeigt werden.
' Ansonsten soll der erste Datensatz angezeigt werden.

Me!lstAuftraege.SetFocus

If IsNull(OpenArgs) Then

   If Nz(lstAuftraege.ListCount) > 0 Then   ' erste Zeile anzeigen
      Me!lstAuftraege = Me!lstAuftraege.ItemData(0)
      Call lstAuftraege_AfterUpdate
   End If

Else
   Me!lstAuftraege = OpenArgs
   Call lstAuftraege_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

Me.Cycle = 1

End Sub

========================================================
Code of the form 'frmHilfe'
========================================================
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmHilfe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option 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 hngt vom Format
' der zu ffnenden Datei ab.

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

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

' Hilfedatei ffnen und anzeigen

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objF = objFso.GetFile(Me.OpenArgs)
Set objTs = objF.OpenAsTextStream(1, lngFiletype)

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

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

End Sub

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

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

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(Liste5) Then
   MsgBox "Bitte whlen Sie den zu lschenden Mitarbeiter aus der Liste!"
   Liste5.SetFocus
   Exit Sub
End If

' Sicherheitsfrage
' (Dabei ist standardmig der zweite Button ("Nein") aktiviert.
'  Wenn der Nutzer also nach Erscheinen der Sicherheitsfrage einfach
'  nur die Enter-Taste drckt, wird NICHT gelscht!)

strMsgtext = "Wollen Sie den Mitarbeiter " & Me!txtVorname & " " & _
             Me!txtName & " wirklich lschen?"
lngAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Ausfhrung des Lschens
' ---------------------------------------------------------------------
' Bevor der Datensatz selber gelscht werden kann, mssen erst
' alle Verweise auf ihn in anderen Tabellen gelscht werden!

' ACHTUNG: Das automatische Lschen des Verweises auf den zu lschenden
'          Mitarbeiter in tblKauf_Mit ist nicht ganz unproblematisch!
'          Damit geht die Information verloren, dass ein bestimmter
'          Mitarbeiter - den es JETZT in der Firma nicht mehr gibt -
'          irgendwann in der VERGANGENHEIT einmal bestimmte Auftrge
'          bearbeitet hat!
'          Es knnte ebenso gut sein, dass der zu lschende Mitarbeiter
'          fr in der ZUKUNFT zu erledigende Auftrge eingeplant war.
'          Nach der Lschung des Mitarbeiters ist dann u.U. fr
'          bestimmte Auftrge NIEMAND mehr eingeplant!
'
' Wenn man verhindern will, dass in der Vergangeheit oder fr die Zukunft
' eingeplante Mitarbeiter gelscht werden, muss man vorgehen wie im
' Modul Form_frmMaterialart bei der Lschung von Materialarten oder
' wie im Modul Form_frmKunden bei der Lschung von Kunden!
'    (In diesen beiden Modulen werden zwei unterschiedliche
'    Lsungsvarianten demonstriert!)
' Das heit: Wenn es noch Fremdschlsseleintrge in tblKauf_Mit gibt,
' kann der betreffende Mitarbeiter nicht gelscht werden.

If lngAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE mit_id_f=" & Str(Me!mit_id)
   CurrentDb.Execute "DELETE FROM tblMitarbeiter WHERE mit_id=" & Str(Me!mit_id)
   Liste5.Requery                        ' Aktualisieren der Liste
   Requery                               ' Aktualisieren des Formulars
   Liste5.SetFocus
   If Nz(Liste5.ListCount) > 0 Then      ' Wenn die Liste nach dem Lschen
                                         ' noch Eintrge enthlt ...
      Me!Liste5 = Me!Liste5.ItemData(0)  ' ... soll die erste Zeile der Liste
      Call Liste5_AfterUpdate            '     angezeigt werden
   End If
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
Liste5 = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfrage

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

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngMitId = Me!mit_id

' Aktualisieren der Mitarbeiterliste

Liste5.Enabled = True
Liste5.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

Liste5.SetFocus
Liste5 = lngMitId
Call Liste5_AfterUpdate

End Sub

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

Me.Recordset.FindFirst "mit_id=" & Me!Liste5

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub


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


Private Sub cmdLoeschen_Click()
'--------------------------------------------------------------
Dim strAntwort As Long
Dim strMsgtext As String

'Wurde ein zu lschender Datensatz ausgewhlt?

If IsNull(lstMitarbeiter) Then
   MsgBox "Bitte whlen Sie den zu lschenden Mitarbeiter aus der Liste!"
   lstMitarbeiter.SetFocus
   Exit Sub
End If

' Sicherheitsfrage
' (Dabei ist standardmig der zweite Button ("Nein") aktiviert.
'  Wenn der Nutzer also nach Erscheinen der Sicherheitsfrage einfach
'  nur die Enter-Taste drckt, wird NICHT gelscht!)

strMsgtext = "Wollen Sie den Mitarbeiter " & Me!txtVorname & " " & _
             Me!txtName & " wirklich lschen?"
strAntwort = MsgBox(strMsgtext, vbYesNo + vbDefaultButton2)

' Lschen
' (Bevor der Datensatz selber gelscht werden kann, mssen erst
'  alle Verweise auf ihn in anderen Tabellen gelscht werden!)

' ACHTUNG: Das automatische Lschen des Verweises auf den zu lschenden
'          Mitarbeiter in tblKauf_Mit ist nicht ganz unproblematisch!
'          Damit geht die Information verloren, dass ein bestimmter
'          Mitarbeiter - den es JETZT in der Firma nicht mehr gibt -
'          irgendwann in der VERGANGENHEIT einmal bestimmte Auftrge
'          bearbeitet hat!
'          Es knnte ebenso gut sein, dass der zu lschende Mitarbeiter
'          fr in der ZUKUNFT zu erledigende Auftrge eingeplant war.
'          Nach der Lschung des Mitarbeiters ist dann u.U. fr
'          bestimmte Auftrge NIEMAND mehr eingeplant!
'
' Wenn man verhindern will, dass in der Vergangeheit oder fr die Zukunft
' eingeplante Mitarbeiter gelscht werden, muss man vorgehen wie im
' Modul Form_frmMaterialart bei der Lschung von Materialarten oder
' wie im Modul Form_frmKunden bei der Lschung von Kunden!
'    (In diesen beiden Modulen werden zwei unterschiedliche
'    Lsungsvarianten demonstriert!)
' Das heit: Wenn es noch Fremdschlsseleintrge in tblKauf_Mit gibt,
' kann der betreffende Mitarbeiter nicht gelscht werden.

If strAntwort = vbYes Then
   CurrentDb.Execute "DELETE FROM tblKauf_Mit WHERE mit_id_f=" & Str(Me!mit_id)
   CurrentDb.Execute "DELETE FROM tblMitarbeiter WHERE mit_id=" & Str(Me!mit_id)
   lstMitarbeiter.Requery                                ' Aktualisieren der Liste
   Requery                                               ' Aktualisieren des Formulars
   lstMitarbeiter.SetFocus
   If Nz(lstMitarbeiter.ListCount) > 0 Then              ' Wenn die Liste nach dem Lschen
                                                         ' noch Eintrge enthlt ...
      Me!lstMitarbeiter = Me!lstMitarbeiter.ItemData(0)  ' ... soll die erste Zeile der Liste
      Call lstMitarbeiter_AfterUpdate                    '     angezeigt werden
   End If
End If

End Sub

Private Sub cmdNeu_Click()
'--------------------------------------------------------------
lstMitarbeiter = Null
DoCmd.GoToRecord , , acNewRec
txtName.SetFocus

End Sub

Private Sub cmdSchliessen_Click()
'--------------------------------------------------------------
DoCmd.Close
End Sub

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

' Sicherheitsfrage

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

' Speicher-Kommando

DoCmd.RunCommand (acCmdSaveRecord)

' Der Primrschlssel des gerade gespeicherten Datensatzes
' wird in einer Variablen zwischengespeichert.
' Er wird am Ende dieser Prozedur bentigt, um den gerade
' gespeicherten Datensatz in der Liste auszuwhlen!

lngMitId = Me!mit_id

' Aktualisieren der Mitarbeiterliste

lstMitarbeiter.Enabled = True
lstMitarbeiter.Requery

' Markieren des gerade gespeicherten Datensatzes in der Liste

lstMitarbeiter.SetFocus
lstMitarbeiter = lngMitId
Call lstMitarbeiter_AfterUpdate

End Sub

Private Sub cmdStartformular_Click()
DoCmd.OpenForm "frmStart"
End Sub

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

Me!lstMitarbeiter.SetFocus
If Nz(lstMitarbeiter.ListCount) > 0 Then   ' erste Zeile anzeigen
   Me!lstMitarbeiter = Me!lstMitarbeiter.ItemData(0)
   Call lstMitarbeiter_AfterUpdate
End If

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub

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

Me.Recordset.FindFirst "mit_id=" & Me!lstMitarbeiter

cmdLoeschen.Enabled = True
cmdNeu.Enabled = True

End Sub


**********************************************************************
**********************************************************************
Code of the module 'Hilfsprozeduren'
**********************************************************************
**********************************************************************
Attribute VB_Name = "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 fr die bedingte Kompilierung"
' Will man dort mehrere Konstanten definieren,
' so mssen sie durch Doppelpunkte voneinander getrennt werden!

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

End Function

#If Accessversion > 2003 Then

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

   Case "startformular"
      DoCmd.OpenForm "frmStart"

   Case "kunden"
      DoCmd.OpenForm "frmKunden"
   Case "kundenauftraege"
      DoCmd.OpenForm "frmKundenauftraege"

   Case "auftragsbearbeitung"
      DoCmd.OpenForm "frmAuftragsbearbeitung"
   Case "personalplanung"
      DoCmd.OpenForm "frmPersonalplanung"

   Case "materialart"
      DoCmd.OpenForm "frmMaterialart"
   Case "mitarbeiter"
      DoCmd.OpenForm "frmMitarbeiter"

   Case Else
      MsgBox "OnButtonClick: Unbekannter Formularname!"

End Select
End Sub
#End If

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

' Fast alle Prozeduren enthalten nmlich am Ende diesen Code:

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

errorhandling = False
End Function

Public Function FormIsOpen(formname As String) As Boolean
Dim objFrm As Form
FormIsOpen = False
For Each objFrm In Forms
   If objFrm.Name = formname Then FormIsOpen = True
Next objFrm
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 knnen Textboxen keine .rtf-Daten darstellen.
' Darum dort nur .txt-Dateien als Hilfedateien!

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

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

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

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

End Sub
