VERSION 5.00
Begin VB.Form frmTastenMenu1 
   BackColor       =   &H80000002&
   BorderStyle     =   0  'Kein
   Caption         =   "Form1"
   ClientHeight    =   4350
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6930
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4350
   ScaleWidth      =   6930
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdTastenMenu1 
      BackColor       =   &H8000000B&
      Caption         =   "&Umbuchen"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   3
      Left            =   3525
      Style           =   1  'Grafisch
      TabIndex        =   3
      Tag             =   "85"
      Top             =   840
      Width           =   1890
   End
   Begin VB.CommandButton cmdTastenMenu1 
      BackColor       =   &H8000000B&
      Caption         =   "&Abmelden"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   0
      Left            =   1200
      Style           =   1  'Grafisch
      TabIndex        =   0
      Tag             =   "65"
      Top             =   0
      Width           =   1935
   End
   Begin VB.CommandButton cmdTastenMenu1 
      Caption         =   "&Extra"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   4
      Left            =   1320
      Style           =   1  'Grafisch
      TabIndex        =   4
      Tag             =   "69"
      Top             =   1800
      Width           =   1840
   End
   Begin VB.CommandButton cmdTastenMenu1 
      Caption         =   "T&OTAL"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   7
      Left            =   3285
      Style           =   1  'Grafisch
      TabIndex        =   7
      Tag             =   "79"
      Top             =   3000
      Width           =   2205
   End
   Begin VB.CommandButton cmdTastenMenu1 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   2
      Left            =   120
      Style           =   1  'Grafisch
      TabIndex        =   2
      Top             =   840
      Width           =   1840
   End
   Begin VB.CommandButton cmdTastenMenu1 
      Caption         =   "&Storno"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   5
      Left            =   3600
      Style           =   1  'Grafisch
      TabIndex        =   5
      Tag             =   "83"
      Top             =   1875
      Width           =   1840
   End
   Begin VB.CommandButton cmdTastenMenu1 
      Caption         =   "&Zw. Summe"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   6
      Left            =   1560
      Style           =   1  'Grafisch
      TabIndex        =   6
      Tag             =   "90"
      Top             =   3000
      Width           =   1485
   End
   Begin VB.CommandButton cmdTastenMenu1 
      BackColor       =   &H8000000B&
      Caption         =   "&Tisch schließen"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   800
      Index           =   1
      Left            =   3360
      Style           =   1  'Grafisch
      TabIndex        =   1
      Tag             =   "84"
      Top             =   0
      Width           =   2040
   End
   Begin VB.Shape shpTastenMenu1 
      BackColor       =   &H80000003&
      BorderColor     =   &H00808080&
      BorderWidth     =   5
      FillColor       =   &H000000FF&
      Height          =   2430
      Left            =   330
      Top             =   240
      Width           =   3030
   End
End
Attribute VB_Name = "frmTastenMenu1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim VarcmdTastenMenu1Index As Integer
'============================ FORMS EREIGNISSE =========================
'=======================================================================
Private Sub Form_Load()
Me.BackColor = &H80000003
For I = 0 To Me.cmdTastenMenu1.Count - 1
  Me.cmdTastenMenu1.Item(I).BackColor = &H80000002
 Next I
VarcmdTastenMenu1Index = 13597
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MDIHauptmenu.TastenFarbeAbheben 'Hebt die Tastenfarben au
VarcmdTastenMenu1Index = 13597
End Sub
'============================ COMMANDBUTTON EREIGNISSE =========================
'===============================================================================
Private Sub cmdTastenMenu1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = VarcmdTastenMenu1Index Then Exit Sub  ' focus vorhanden Wegen Bildzittern gehe raus
VarTastenFarbeAbheben = False ' in MDI-Formular benutzt
VarcmdTastenMenu1Index = Index

For I = 0 To Me.cmdTastenMenu1.Count - 1
 If I = Index Then
  Me.cmdTastenMenu1.Item(I).BackColor = &H80C0FF
  Me.cmdTastenMenu1.Item(I).MousePointer = 99
  Set Me.cmdTastenMenu1.Item(I).MouseIcon = LoadPicture(App.Path & "\Cursors\harrow.cur")
 Else
  Me.cmdTastenMenu1.Item(I).BackColor = &H80000002
 End If
Next I
End Sub
Private Sub cmdTastenMenu1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
frmSchnellwahltaste.MSHFlexGrid1.Visible = False
If frmTastenMenu2.txtPLU.Text <> "" Then
    frmTastenMenu2.txtPLU = ""
End If
Call TastenMenu1(cmdTastenMenu1(Index).Tag)
End Sub
'============================ PROZEDUREN =========================
'=================================================================
Sub TastenMenu1(VarKeyCode)
Select Case VarKeyCode
 
 Case 65 'Abmelden
  Call ReportStornozettel.Stornozettel("Thekendrucker", "Storno-Theke")
  While ReportStornozettel.AsyncCount > 0
  DoEvents
  Wend
  
  Call ReportStornozettel.Stornozettel("Küchendrucker", "Storno-Küche")
  
  Call Me.StornosTemporaerLoeschen

  
  Call ReportTheke.TischNeuesGericht("Thekendrucker", "Thekenbon")
  
  While ReportTheke.AsyncCount > 0
  DoEvents
  Wend
  Call ReportKüche.TischNeuesGericht("Küchendrucker", "Küchenbon")
 
  Call Me.TischNeuesGerichtLoeschen
  Call Me.BesetzteTische
  
  frmTisch.Visible = False
  frmTastenMenu1.Visible = False
  frmSchnellwahltaste.Visible = False
  frmkarteAuswahl.Visible = False
  
  frmTastenMenu2.Visible = False
  frmLink.Visible = True
  MDIHauptmenu.imgMenu.Visible = True
  
  frmPin.Show 1 'Übeprüfen von Pin
  frmRaum.Visible = True
 

 
 
 Case 84 'Tisch Schließen
  Call ReportStornozettel.Stornozettel("Thekendrucker", "Storno-Theke")
  While ReportStornozettel.AsyncCount > 0
  DoEvents
  Wend
  Call ReportStornozettel.Stornozettel("Küchendrucker", "Storno-Küche")
  
  Call Me.StornosTemporaerLoeschen
  
  
  Call ReportTheke.TischNeuesGericht("Thekendrucker", "Thekenbon")

  While ReportTheke.AsyncCount > 0
  DoEvents
  Wend
    
  Call ReportKüche.TischNeuesGericht("Küchendrucker", "Küchenbon")

  Call Me.TischNeuesGerichtLoeschen
  Call Me.BesetzteTische
 
  frmTisch.Visible = False
  frmTastenMenu1.Visible = False
  frmSchnellwahltaste.Visible = False
  frmkarteAuswahl.Visible = False
  
  frmTastenMenu2.Visible = False
  frmLink.Visible = True
  MDIHauptmenu.imgMenu.Visible = True
  frmRaum.Visible = True
Case 83 'Stornieren
  'Prüffen ob betreffende Rechte vorhanden sind
         If modRechte.MitarbeiterRecht(VarKellner, "Stornieren") = False Then
           MsgBox "Sie haben nicht die nötigen Rechte, um diese Aktion auszuführen"
           Exit Sub
         End If
    If frmTisch.dgrTisch.Row = -1 Then Exit Sub
    frmTastenMenu2.TimerMenu2.Enabled = False
    If frmTisch.dgrTisch.Columns("TischDetails").Text = "Alt" And frmTisch.dgrTisch.Columns("Extra").Text = "Ja" Then
      Call mdlDatenbanken.DatensatzExtraLoeschen(frmTisch.dgrTisch.Columns("RegID").Text)
    ElseIf frmTisch.dgrTisch.Columns("TischDetails").Text = "Neu" And frmTisch.dgrTisch.Columns("PLU").Text <> "" And frmTisch.dgrTisch.Columns("Extra").Text = "Ja" Then
      Call mdlDatenbanken.DatensatzExtraLoeschen(frmTisch.dgrTisch.Columns("RegID").Text)
    Else
      Call mdlDatenbanken.DatensatzStornieren(frmTisch.dgrTisch.Columns("ID").Text, frmTisch.dgrTisch.Columns("PLU").Text, frmTisch.dgrTisch.Columns("E-Preis").Text)
    End If
    
    
    If frmTisch.dgrTisch.Columns("TischDetails").Text = "Alt" Then
      Call mdlDatenbanken.TischAktualisieren(VarTisch, "Alt")
    Else
      Call mdlDatenbanken.TischAktualisieren(VarTisch, "Neu")
    End If
    frmTastenMenu2.TimerMenu2.Enabled = True

Case 69 'Extra

If frmTisch.dgrTisch.Row = -1 Then Exit Sub

On Error Resume Next



If frmTisch.dgrTisch.Columns("TischDetails").Text = "Neu" And Me.PruefenExtra Then
  frmExtra.Show 1
End If

Case 85 'Umbuchen

If frmTisch.dgrTisch.Row = -1 Then Exit Sub



If TischNeuesGerichtPruefen = True Then
 MsgBox "Bei neuen eingetragenen Gerichte ist Umbuchen nicht möglich."
 Exit Sub
End If

On Error Resume Next
frmTastenMenu2.TimerMenu2.Enabled = False
frmTischUmbuchen.Show 1
frmTastenMenu2.TimerMenu2.Enabled = True



Case 90 'Zwischensumme
  Call ReportZwischensumme.Zwischensumme
Case 79 'Total
      'Prüffen ob betreffende Rechte vorhanden sind
         If modRechte.MitarbeiterRecht(VarKellner, "Abkassieren") = False Then
           MsgBox "Sie haben nicht die nötigen Rechte, um diese Aktion auszuführen"
           Exit Sub
         End If
      
      
      If ReportAbrechnung.Abrechnung(VarTisch, "0") = Falsch Then Exit Sub 'Tisch ist Leer


      Call ReportStornozettel.Stornozettel("ThekenDrucker", "Storno-Theke")
      While ReportStornozettel.AsyncCount > 0
      DoEvents
      Wend
      Call ReportStornozettel.Stornozettel("Küchendrucker", "Storno-Küche")
      
      StornosTemporaerLoeschen
    
      
      Call ReportTheke.TischNeuesGericht("ThekenDrucker", "Thekenbon")
      
      While ReportTheke.AsyncCount > 0
      DoEvents
      Wend
      Call ReportKüche.TischNeuesGericht("Küchendrucker", "Küchenbon")
      Me.TischNeuesGerichtLoeschen
    
     On Error Resume Next
     frmTastenMenu2.TimerMenu2.Enabled = False
     frmTotal.Show 1
     frmTastenMenu2.TimerMenu2.Enabled = True
End Select
End Sub
Sub TischNeuesGerichtLoeschen()
Dim objConn As ADODB.Connection
Dim rsTischNeuesGericht As ADODB.Recordset
Dim rsTischAltesGericht As ADODB.Recordset
Dim rsErsterAngemelderteKellner As ADODB.Recordset

Dim strPath As String

Set objConn = New ADODB.Connection
Set rsTischAltesGericht = New ADODB.Recordset
Set rsTischNeuesGericht = New ADODB.Recordset
Set rsErsterAngemelderteKellner = New ADODB.Recordset

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

   
      'Prüffe ob Tisch vorhanden und Tisch-Kellner ermitteln
   With rsErsterAngemelderteKellner
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *From OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "' and TischDetails='Alt'"
   End With

   
   If rsErsterAngemelderteKellner.EOF = True Then
     VarErsterAngemelderteKellner = VarKellner 'kein Tisch vorhanden
   Else
     'Tisch vorhanden, alles auf Tisch-Kellner buchen
     VarErsterAngemelderteKellner = rsErsterAngemelderteKellner.Fields("Kellner").Value
   End If
   
     
   
   
   
   
   'Tabelle OffeneTische öffnen
   With rsTischNeuesGericht
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *From OffeneTische Where Station = '" & VarStation & "' and Kellner='" & VarKellner & "' and Tisch='" & VarTisch & "' and TischDetails='Neu'"
   End With


 'Recordset durchlaufen und neu Eintäge auf alt umbuchen löschen.

  While Not rsTischNeuesGericht.EOF
     
       With rsTischAltesGericht
        .ActiveConnection = objConn
        .CursorLocation = adUseClient
        .LockType = adLockOptimistic
        .Open "Select *From OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "' and TischDetails='Alt' and PLU='" & rsTischNeuesGericht.Fields("PLU_ID").Value & "' and Extra='" & rsTischNeuesGericht.Fields("Extra").Value & "' and EPREIS='" & rsTischNeuesGericht.Fields("EPREIS").Value & "'"
       End With
       
       If rsTischAltesGericht.EOF = True Then
         rsTischAltesGericht.AddNew
         For k = 1 To rsTischAltesGericht.Fields.Count - 1
          rsTischAltesGericht.Fields(k).Value = rsTischNeuesGericht.Fields(k).Value
         Next k
         rsTischAltesGericht.Fields("TischDetails").Value = "Alt"
         rsTischAltesGericht.Fields("Kellner").Value = VarErsterAngemelderteKellner
       Else
         
         If rsTischAltesGericht.Fields("Extra").Value = "Ja" Then
            rsTischAltesGericht.AddNew
            For k = 1 To rsTischAltesGericht.Fields.Count - 1
             rsTischAltesGericht.Fields(k).Value = rsTischNeuesGericht.Fields(k).Value
            Next k
            rsTischAltesGericht.Fields("TischDetails").Value = "Alt"
            rsTischAltesGericht.Fields("Kellner").Value = VarErsterAngemelderteKellner
          Else
            rsTischAltesGericht.Fields("Menge").Value = rsTischAltesGericht.Fields("Menge").Value + rsTischNeuesGericht.Fields("Menge").Value
            rsTischAltesGericht.Fields("Menge_text").Value = rsTischAltesGericht.Fields("Menge").Value & "x"
            rsTischAltesGericht.Fields("GPREIS").Value = Format(rsTischAltesGericht.Fields("Menge").Value * rsTischAltesGericht.Fields("EPREIS").Value, "####0.#0")
            rsTischAltesGericht.Fields("Kellner").Value = VarErsterAngemelderteKellner
          End If
       End If
       rsTischAltesGericht.Update 'Datenbank Aktualisieren
       rsTischAltesGericht.Close
    
  rsTischNeuesGericht.Delete
  rsTischNeuesGericht.MoveNext
 Wend
 
 
 'Objekte aus dem Speicher leeren
Set rsErsterAngemelderteKellner = Nothing
Set rsTischNeuesGericht = Nothing
Set rsTischAltesGericht = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0

Set rsErsterAngemelderteKellner = Nothing
Set rsTischNeuesGericht = Nothing
Set rsTischAltesGericht = Nothing
Set objConn = Nothing
  
  Exit Sub

err_Handler:
    MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsErsterAngemelderteKellner = Nothing
Set rsTischNeuesGericht = Nothing
Set rsTischAltesGericht = Nothing
Set objConn = Nothing

End Sub
Sub StornosTemporaerLoeschen()
Dim objConn As ADODB.Connection
Dim rsStornosTemporaer As ADODB.Recordset
Dim rsStornos As ADODB.Recordset
Dim strPath As String

Set objConn = New ADODB.Connection
Set rsStornosTemporaer = New ADODB.Recordset
Set rsStornos = New ADODB.Recordset

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
  
   'StornosTemporaer öffnen
   With rsStornosTemporaer
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *from StornosTemporaer"
   End With
  'Stornos öffnen
  With rsStornos
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *from Stornos"
   End With
  
  
  If rsStornosTemporaer.EOF Then GoTo 10
  'Recordset durchlaufen und alte Eintäge löschen.

  While Not rsStornosTemporaer.EOF
    rsStornos.AddNew
    For I = 1 To rsStornosTemporaer.Fields.Count - 1
      rsStornos(I).Value = rsStornosTemporaer.Fields(I).Value
    Next I
    rsStornos.Fields("Zeit").Value = Format(Time, "hh:mm")

   rsStornos.Update
   rsStornosTemporaer.Delete
   rsStornosTemporaer.MoveNext
  Wend
  'rsStornosTemporaer.Update
 
 'Objekte aus dem Speicher leeren
10 Set rsStornosTemporaer = Nothing
   Set rsStornos = Nothing
   Set objConn = Nothing

exit_Sub:
  On Error GoTo 0
Set rsStornosTemporaer = Nothing
Set rsStornos = Nothing
Set objConn = Nothing
  
  Exit Sub

err_Handler:
    MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsStornosTemporaer = Nothing
Set rsStornos = Nothing
Set objConn = Nothing

End Sub
Function TischNeuesGerichtPruefen()
Dim objConn As ADODB.Connection
Dim rsTischNeupruefen As ADODB.Recordset
Dim strPath As String

Set objConn = New ADODB.Connection
Set rsTischNeupruefen = New ADODB.Recordset

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
  
   'Tabelle TischeNeu öffnen
   With rsTischNeupruefen
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *From OffeneTische Where Station = '" & VarStation & "' and Kellner='" & VarKellner & "' and Tisch='" & VarTisch & "' and TischDetails='Neu'"
   End With
  
  If rsTischNeupruefen.EOF = True Then
    TischNeuesGerichtPruefen = False
  Else
     TischNeuesGerichtPruefen = True
  End If
  
Set rsTischNeupruefen = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0
Set rsTischNeupruefen = Nothing
Set objConn = Nothing
  
  Exit Function

err_Handler:
    MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsTischNeupruefen = Nothing
Set objConn = Nothing

End Function
Sub BesetzteTische()
Dim objConn As ADODB.Connection
Dim rsBesetzteTische As ADODB.Recordset
Dim strPath As String

Set objConn = New ADODB.Connection
Set rsBesetzteTische = New ADODB.Recordset

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
  
   'Tabelle OffeneTische öffnen
   With rsBesetzteTische
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     '.Open "Select Tisch from OffeneTische Group by Tisch"
     .Open "Select Tisch from OffeneTische Where Station = '" & VarStation & "' and Kellner='" & VarKellner & "' and Tisch='" & VarTisch & "'Group by Tisch "
   End With
  
  'Recordset prüfen welche Tische sind besetzt.
If rsBesetzteTische.EOF = True Then
      For I = 1 To frmRaum.picTisch.UBound
        If frmRaum.picTisch(I).Tag = VarTisch Then
          Set frmRaum.picTisch(I).Picture = LoadPicture("") 'Wenn nicht besetzt kein Bild
        End If
      Next I
End If
'Objekte aus dem Speicher leeren
Set rsBesetzteTische = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0

Set rsBesetzteTische = Nothing
Set objConn = Nothing
  
  Exit Sub

err_Handler:
    MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsBesetzteTische = Nothing
Set objConn = Nothing

End Sub
Function PruefenExtra()
Dim objConn As ADODB.Connection
Dim rsPruefenExtra As ADODB.Recordset
Dim strPath As String

Set objConn = New ADODB.Connection
Set rsPruefenExtra = New ADODB.Recordset

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
  
   'Tabelle TischeNeu öffnen
   With rsPruefenExtra
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *From Artikelgruppe Where PLU = '" & frmTisch.dgrTisch.Columns("PLU").Text & "' and Extra = True"
   End With
  
  If rsPruefenExtra.EOF = True Then
    PruefenExtra = False
  Else
     PruefenExtra = True
  End If
  
Set rsPruefenExtra = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0
Set rsPruefenExtra = Nothing
Set objConn = Nothing
  
  Exit Function

err_Handler:
    MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsPruefenExtra = Nothing
Set objConn = Nothing

End Function