Attribute VB_Name = "MdlDatenbank"
'---------Tabelle Stationen abfragen-------------

Sub Stationen()
Dim objConn As ADODB.Connection
Dim rsRaum As ADODB.Recordset
Set objConn = New ADODB.Connection
Set rsStationen = New ADODB.Recordset
Dim strPath As String

  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"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With


  With rsStationen
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM Stationen"
  
   End With

  While Not rsStationen.EOF
 VarIndex = rsStationen.AbsolutePosition

'Alle 4 Räume(Steuerelemente) laden und zeigen sowie Positionieren
 'Element 1

 Load frmLink.picStationenLink(VarIndex)
 If VarIndex = 1 Then
 frmLink.picStationenLink(VarIndex).Top = 3 * frmLink.lblOberflaecheLink1.Height
 Else
 frmLink.picStationenLink(VarIndex).Top = frmLink.picStationenLink(VarIndex - 1).Top + frmLink.picStationenLink(VarIndex - 1).Height + frmLink.picStationenLink(VarIndex - 1).Height / 2
 End If
  frmLink.picStationenLink(VarIndex).Left = (frmLink.ScaleWidth - frmLink.picStationenLink(VarIndex).Width) / 2
 
 frmLink.picStationenLink(VarIndex).Tag = rsStationen.Fields("Station").Value
 frmLink.picStationenLink(VarIndex).Visible = True
 frmLink.picStationenLink(VarIndex).ZOrder 0
 'Element 2
 Load frmLink.imgStationenLink(VarIndex)
 Set frmLink.imgStationenLink(VarIndex).Container = frmLink.picStationenLink(VarIndex) ' picStationenLink(VarIndex).Container
 frmLink.imgStationenLink(VarIndex).Visible = True

 'Element 3
  Load frmLink.ShapeStationenLink(VarIndex)
  Set frmLink.ShapeStationenLink(VarIndex).Container = frmLink.picStationenLink(VarIndex) ' picStationenLink(VarIndex).Container
  frmLink.ShapeStationenLink(VarIndex).Visible = True
 'Element 4
  Load frmLink.lblStationenLink(VarIndex)
  Set frmLink.lblStationenLink(VarIndex).Container = frmLink.picStationenLink(VarIndex) ' picStationenLink(VarIndex).Container
  frmLink.lblStationenLink(VarIndex).Visible = True
  frmLink.lblStationenLink(VarIndex).Caption = rsStationen.Fields("Station").Value
 
 
 rsStationen.MoveNext
Wend
 
 
 

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

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


End Sub
'---------Tabelle Verwaltung abfragen-------------

Sub Verwaltung()
Dim objConn As ADODB.Connection
Dim rsRaum As ADODB.Recordset
Set objConn = New ADODB.Connection
Set rsVerwaltung = New ADODB.Recordset
Dim strPath As String

  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"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With


  With rsVerwaltung
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM Verwaltung"
  
   End With

  While Not rsVerwaltung.EOF
 VarIndex = rsVerwaltung.AbsolutePosition

'Alle 4 Räume(Steuerelemente) laden und zeigen sowie Positionieren
 'Element 1

 Load frmLink.picVerwaltungLink(VarIndex)
 frmLink.picVerwaltungLink(VarIndex).Tag = rsVerwaltung.Fields("Verwaltung").Value
 If VarIndex = 1 Then
 frmLink.picVerwaltungLink(VarIndex).Top = 3 * frmLink.lblOberflaecheLink1.Height
 Else
 frmLink.picVerwaltungLink(VarIndex).Top = frmLink.picVerwaltungLink(VarIndex - 1).Top + frmLink.picVerwaltungLink(VarIndex - 1).Height + frmLink.picVerwaltungLink(VarIndex - 1).Height / 2
 End If
 'frmLink.picVerwaltungLink(VarIndex).Visible = True
 frmLink.picVerwaltungLink(VarIndex).ZOrder 0
 'Element 2
 Load frmLink.imgVerwaltungLink(VarIndex)
 Set frmLink.imgVerwaltungLink(VarIndex).Container = frmLink.picVerwaltungLink(VarIndex)
 frmLink.imgVerwaltungLink(VarIndex).Visible = True

 'Element 3
  Load frmLink.ShapeVerwaltungLink(VarIndex)
  Set frmLink.ShapeVerwaltungLink(VarIndex).Container = frmLink.picVerwaltungLink(VarIndex)
  frmLink.ShapeVerwaltungLink(VarIndex).Visible = True
  
 'Element 4
  Load frmLink.lblVerwaltungLink(VarIndex)
  Set frmLink.lblVerwaltungLink(VarIndex).Container = frmLink.picVerwaltungLink(VarIndex)
  frmLink.lblVerwaltungLink(VarIndex).Caption = rsVerwaltung.Fields("Verwaltung").Value
  frmLink.lblVerwaltungLink(VarIndex).Visible = True

 rsVerwaltung.MoveNext
Wend
 
 
 

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

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


End Sub
'--------------Tabelle PicTisch abfragen----------------------
Sub TabellePicTischAbfragen(frm, VarStation)

Dim objConn As ADODB.Connection
Dim rsTabellePicTisch As ADODB.Recordset
Set objConn = New ADODB.Connection
Set rsTabellePicTisch = New ADODB.Recordset


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

  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
With rsTabellePicTisch
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM TabellePicTisch Where Station='" & VarStation & "'"
End With


'Aktuelle Steuerelemente entladen

If frm.picTisch.UBound > 0 Then
For I = 1 To frm.picTisch.Count - 1
Unload frm.picTisch(I)
Next I
End If

'Tabelle durchlaufen
VarIndex = 0

While Not rsTabellePicTisch.EOF
VarIndex = VarIndex + 1
Load frm.picTisch(VarIndex)
If frm.Name = "frmRaum" Then
frm.picTisch(VarIndex).Top = rsTabellePicTisch.Fields("Oben") + frmRaum.ScaleWidth / 20
frm.picTisch(VarIndex).Left = rsTabellePicTisch.Fields("Links") + frmRaum.ScaleHeight / 25
Else
frm.picTisch(VarIndex).Top = rsTabellePicTisch.Fields("Oben")
frm.picTisch(VarIndex).Left = rsTabellePicTisch.Fields("Links")
End If

frm.picTisch(VarIndex).Width = rsTabellePicTisch.Fields("Breite").Value
frm.picTisch(VarIndex).Height = rsTabellePicTisch.Fields("Hoehe").Value
'Name von Steuerelement bzw. Tisch wird gespeichert
frm.picTisch(VarIndex).Tag = rsTabellePicTisch.Fields("Name").Value

frm.Visible = True
frm.picTisch(VarIndex).Visible = True
'frm.picTisch(VarIndex).CurrentX = (frm.picTisch(VarIndex).Width - frm.picTisch(VarIndex).TextWidth(frm.picTisch(VarIndex).Tag)) / 2
'frm.picTisch(VarIndex).CurrentY = (frm.picTisch(VarIndex).Height - frm.picTisch(VarIndex).TextHeight(frm.picTisch(VarIndex).Tag)) / 2
'frm.picTisch(VarIndex).Print frm.picTisch(VarIndex).Tag

rsTabellePicTisch.MoveNext
Wend


Set objConn = Nothing
Set rsTabellePicTisch = Nothing
End Sub
'--------- Stationberechtigung und Tabelle OffeneTische Abfragen-------------
Sub TischAbfragen(VarKellner, VarStation, VarTisch)
Dim objConn As New ADODB.Connection
Dim rsStation As New ADODB.Recordset
Dim rsTisch As New ADODB.Recordset


Dim strPath As String

Set objConn = New ADODB.Connection
Set rsStation = New ADODB.Recordset
Set rsTisch = New ADODB.Recordset

  MsgBox "ok"

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

  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
 
  'Stationberechigung vom Kellner überprüfen
     
   With rsStation
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM Kellner"
   End With
  
 While Not rsStation.EOF = True
  If rsStation.Fields("Kellner").Value = VarKellner Then 'für diesen Kellner überprüffen
     If rsStation.Fields(VarStation).Value = False Then 'Wenn keine Rechte vorhanden
       MsgBox "Sie haben keine Berechtigung diese Station zu öffnen"
       Exit Sub
     End If
  End If
 rsStation.MoveNext
 Wend
  
  
  'Überprüfen ob Tisch und station übereinstimmen
  With rsTisch
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select ID,Station,Kellner,Tisch,Drucker,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "'"
  End With

If rsTisch.EOF = False Then 'Datensatz wurde gefunden
   'Datensatz wurde gefunden(Station und Tisch stimmen überein)
    rsTisch.AbsolutePosition = 1
    If VarKellner <> rsTisch.Fields("Kellner").Value Then 'überprüfen ob auch Kellner Übereinstimmt
      MsgBox "Sie haben keine Berechtigung diesen Tisch zu öffnen"
      Exit Sub
    End If
Else 'Datensatz wurde nicht gefunden
'Datensatz wurde nicht gefunden(Station oder Tisch stimmen nicht überein)
'Tisch ist frei gehe weiter.. und öffne Tisch
End If

 
 Set frmTisch.dgrTisch.DataSource = rsTisch
 frmTisch.dgrTisch.Columns("ID").Visible = False
 frmTisch.dgrTisch.Columns("Station").Visible = False
 frmTisch.dgrTisch.Columns("Kellner").Visible = False
 frmTisch.dgrTisch.Columns("Tisch").Visible = False
 frmTisch.dgrTisch.Columns("Drucker").Visible = False

 frmTisch.dgrTisch.Columns("PLU").Width = 0.4 * frmTisch.dgrTisch.Width / 6
 frmTisch.dgrTisch.Columns("Menge").Width = 0.5 * frmTisch.dgrTisch.Width / 6
 frmTisch.dgrTisch.Columns("Menge").Alignment = dbgCenter
 frmTisch.dgrTisch.Columns("Gericht").Width = 4 * frmTisch.dgrTisch.Width / 6
 frmTisch.dgrTisch.Columns("E-Preis").Width = 0.5 * frmTisch.dgrTisch.Width / 6
 frmTisch.dgrTisch.Columns("E-Preis").Alignment = dbgRight
 frmTisch.dgrTisch.Columns("G-Preis").Width = 0.5 * frmTisch.dgrTisch.Width / 6
 frmTisch.dgrTisch.Columns("G-Preis").Alignment = dbgRight

 'frmTisch.dgrTisch.SetFocus
 
If frmTisch.cmdTisch.Caption = "Alles" Then
  
  frmTisch.dgrTisch.Row = rsTisch.RecordCount - 1
 'Selection modus setzen
 If rsTisch.RecordCount > 0 Then
    frmTisch.dgrTisch.Row = rsTisch.RecordCount - 1
 
    'Selection modus setzen
    If frmTisch.dgrTisch.SelBookmarks.Count <> 0 Then frmTisch.dgrTisch.SelBookmarks.Remove 0
        frmTisch.dgrTisch.SelBookmarks.Add frmTisch.dgrTisch.Bookmark
        SendKeys "{ESC}"
    frmTisch.dgrTisch.Scroll 0, 1000
 End If
End If


 
 
 TischSumme
    
    
    'frmTastenMenu2.TimerMenu2.Enabled = True 'Aktivieren von Timer
    'frmTastenMenu2.TimerMenu2.Interval = 50
    
    frmRaum.Visible = False
    frmLink.Visible = False

    frmTisch.Visible = True
    frmTastenMenu1.Visible = True
    frmTastenMenu2.Visible = True
    
    If frmTastenMenu2.cmdTastenMenu2(14).Caption = "Speisekarte" Then
    frmSchnellwahltaste.Visible = True
    frmkarteAuswahl.Visible = False
    Else
    frmkarteAuswahl.Visible = True
    frmSchnellwahltaste.Visible = False
    End If
    

Set rsStation = Nothing
Set rsTisch = Nothing
Set objConn = Nothing

End Sub
Sub DatensatzFinden(VarBefehl, VarStation, VarTisch, VarMenge)

Dim objConn As ADODB.Connection
Dim rsOffeneTische As ADODB.Recordset
Dim rsGericht As ADODB.Recordset
Dim rsTischNeuesGericht As ADODB.Recordset

Dim strPath As String

Set objConn = New ADODB.Connection
Set rsOffeneTische = New ADODB.Recordset
Set rsTischNeuesGericht = New ADODB.Recordset
Set rsGericht = 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"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

'Tabelle Artikelgruppe öffnen und Gericht suchen
  With rsGericht
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM Artikelgruppe "
    .Find (VarBefehl)
  End With

 'Wenn Gericht nicht vorhanden meldung zeigen
  If rsGericht.EOF = True Then
    MsgBox "Gericht nicht gefunden"
    Set rsGericht = Nothing
    Set rsOffeneTische = Nothing
    Set objConn = Nothing
    Exit Sub
   End If  'sonst weiter
    
    'Tabelle OffeneTische öffnen
    With rsOffeneTische
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select ID,Station,Kellner,Tisch,Drucker,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM OffeneTische Where Tisch='" & VarTisch & "' and Station='" & VarStation & "' and Kellner='" & VarKellner & "'"
     .Find (VarBefehl)
    End With
    
    If rsOffeneTische.EOF = True Then
     rsOffeneTische.AddNew
     rsOffeneTische.Fields("Menge") = VarMenge
      Else
      'Datensatz Gefunden
    rsOffeneTische.Fields("Menge") = VarMenge + rsOffeneTische.Fields("Menge")
    
    End If
    
    rsOffeneTische.Fields("Station") = VarStation
    rsOffeneTische.Fields("Kellner") = VarKellner
    rsOffeneTische.Fields("Tisch") = VarTisch
    rsOffeneTische.Fields("Drucker") = rsGericht.Fields("Drucker")
    rsOffeneTische.Fields("PLU") = rsGericht.Fields("PLU")
    rsOffeneTische.Fields("Gericht") = rsGericht.Fields("Gericht")
    
    rsOffeneTische.Fields("E-Preis") = rsGericht.Fields("VP")
    rsOffeneTische.Update 'Recordset Aktualisieren
    rsOffeneTische.Requery 'Datenbank Aktualisieren
    
  'Tabelle TischeNeu öffnen
   With rsTischNeuesGericht
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select ID,Station,Kellner,Tisch,Drucker,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM TischNeuesGericht"
     .Find (VarBefehl)
   End With
     
    'Tabelle TischNeuesGericht Daten eintragen
    If rsTischNeuesGericht.EOF = True Then
        rsTischNeuesGericht.AddNew
        rsTischNeuesGericht.Fields("Menge") = VarMenge
      Else
        'Datensatz Gefunden
        rsTischNeuesGericht.Fields("Menge") = VarMenge + rsTischNeuesGericht.Fields("Menge")
    End If
    
    rsTischNeuesGericht.Fields("Kellner") = VarKellner
    rsTischNeuesGericht.Fields("Station") = VarStation
    rsTischNeuesGericht.Fields("Tisch") = VarTisch
    rsTischNeuesGericht.Fields("Drucker") = rsGericht.Fields("Drucker")
    rsTischNeuesGericht.Fields("PLU") = rsGericht.Fields("PLU")
    rsTischNeuesGericht.Fields("Gericht") = rsGericht.Fields("Gericht")
 
    rsTischNeuesGericht.Fields("E-Preis") = rsGericht.Fields("VP")
 
    rsTischNeuesGericht.Update 'Recordset Aktualisieren
    rsTischNeuesGericht.Requery 'Datenbank Aktualisieren
   
   Call TischAbfragen(VarKellner, VarStation, VarTisch)
   Call frmTisch.TischNeueGerichte
   frmTisch.cmdTisch.Caption = "Neu"

'Objekte aus dem Speicher leeren
Set rsGericht = Nothing
Set rsOffeneTische = Nothing
Set rsTischNeuesGericht = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0
Set rsGericht = Nothing
Set rsOffeneTische = Nothing
Set rsTischNeuesGericht = Nothing
Set objConn = Nothing
  
  Exit Sub

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

End Sub
Sub DatensatzEintragen(VarDrucker, VarPLU, VarMenge, VarGericht, VarEPreis)
Dim objConn As ADODB.Connection
Dim rsOffeneTische As ADODB.Recordset
Dim rsTischNeuesGericht As ADODB.Recordset
Dim strPath As String

Set objConn = New ADODB.Connection
Set rsOffeneTische = New ADODB.Recordset
Set rsTischNeuesGericht = 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"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

         'Tabelle OffeneTische öffnen
    With rsOffeneTische
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select ID,Station,Kellner,Tisch,Drucker,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM OffeneTische Where Tisch='" & VarTisch & "' and Station='" & VarStation & "' and Kellner='" & VarKellner & "' and PLU='" & VarPLU & "' and VP='" & VarEPreis & "'"
    End With
    
    If rsOffeneTische.EOF = True Then
     rsOffeneTische.AddNew
     rsOffeneTische.Fields("Menge") = VarMenge
      Else
      'Datensatz Gefunden
    rsOffeneTische.Fields("Menge") = VarMenge + rsOffeneTische.Fields("Menge")
    
    End If
    
    rsOffeneTische.Fields("Station") = VarStation
    rsOffeneTische.Fields("Kellner") = VarKellner
    rsOffeneTische.Fields("Tisch") = VarTisch
    rsOffeneTische.Fields("Drucker") = VarDrucker
    rsOffeneTische.Fields("PLU") = VarPLU
    rsOffeneTische.Fields("Gericht") = VarGericht
    
    rsOffeneTische.Fields("E-Preis") = VarEPreis
    rsOffeneTische.Update 'Recordset Aktualisieren
    rsOffeneTische.Requery 'Datenbank Aktualisieren
    
   'Tabelle TischeNeu öffnen
   With rsTischNeuesGericht
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select ID,Station,Kellner,Tisch,Drucker,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM TischNeuesGericht Where PLU='" & VarPLU & "' and VP='" & VarEPreis & "'"
   End With
     
    'Tabelle TischNeuesGericht Daten eintragen
    If rsTischNeuesGericht.EOF = True Then
        rsTischNeuesGericht.AddNew
        rsTischNeuesGericht.Fields("Menge") = VarMenge
      Else
        'Datensatz Gefunden
        rsTischNeuesGericht.Fields("Menge") = VarMenge + rsTischNeuesGericht.Fields("Menge")
    End If
    
    rsTischNeuesGericht.Fields("Kellner") = VarKellner
    rsTischNeuesGericht.Fields("Station") = VarStation
    rsTischNeuesGericht.Fields("Tisch") = VarTisch
    rsTischNeuesGericht.Fields("Drucker") = VarDrucker
    rsTischNeuesGericht.Fields("PLU") = VarPLU
    rsTischNeuesGericht.Fields("Gericht") = VarGericht
 
    rsTischNeuesGericht.Fields("E-Preis") = VarEPreis
 
    rsTischNeuesGericht.Update 'Recordset Aktualisieren
    rsTischNeuesGericht.Requery 'Datenbank Aktualisieren

   
   Call TischAbfragen(VarKellner, VarStation, VarTisch)
   Call frmTisch.TischNeueGerichte
   frmTisch.cmdTisch.Caption = "Neu"

'Objekte aus dem Speicher leeren
Set rsGericht = Nothing
Set rsOffeneTische = Nothing
Set rsTischNeuesGericht = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0
Set rsGericht = Nothing
Set rsOffeneTische = Nothing
Set rsTischNeuesGericht = Nothing
Set objConn = Nothing
  
  Exit Sub

err_Handler:
    MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsGericht = Nothing
Set rsOffeneTische = Nothing
Set rsTischNeuesGericht = Nothing
Set objConn = Nothing
End Sub
Sub DatensatzLoeschen(VarPLU, VarVP)
Dim Wert As Integer

Dim objConn As ADODB.Connection
Dim rsTischAlles As ADODB.Recordset
Dim rsTischNeu As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsTischAlles = New ADODB.Recordset
Set rsTischNeu = New ADODB.Recordset

Dim strPath As String

  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"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

  With rsTischAlles
    .ActiveConnection = objConn
    '.CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "Select ID,Station,Kellner,Tisch,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM OffeneTische Where Kellner='" & VarKellner & "' and Station='" & VarStation & "' and Tisch='" & VarTisch & "' and PLU='" & VarPLU & "' and VP='" & VarVP & "'"
  End With
   
  With rsTischNeu
    .ActiveConnection = objConn
    '.CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "Select ID,Station,Kellner,Tisch,PLU,Menge,Gericht,VP AS [E-Preis],Menge*VP AS [G-Preis] FROM TischNeuesGericht Where PLU='" & VarPLU & "' and VP='" & VarVP & "'"
  End With
Select Case frmTisch.cmdTisch.Caption
  Case "Neu"
If rsTischNeu.EOF = True Then
      MsgBox "Storno nicht gefunden"
Else
    
      If rsTischNeu.Fields("Menge").Value = 1 Then
        rsTischNeu.Delete
        Wert = 1
      Else
        Wert = InputBox("Geben Sie ein Wert ein.")
        If Wert > 0 And Wert < rsTischNeu.Fields("Menge").Value Then
                rsTischNeu.Fields("Menge").Value = rsTischNeu.Fields("Menge").Value - Wert
        ElseIf Wert = rsTischNeu.Fields("Menge").Value Then
            rsTischNeu.Delete
        End If
      End If
       rsTischNeu.Update 'Aktualisiert das Recordset
       rsTischNeu.Requery 'Aktualisiert die Datenbank
      
      If rsTischAlles.Fields("Menge").Value = 1 Then
        rsTischAlles.Delete
      Else
        If Wert > 0 And Wert < rsTischAlles.Fields("Menge").Value Then
          rsTischAlles.Fields("Menge").Value = rsTischAlles.Fields("Menge").Value - Wert
        ElseIf Wert = rsTischAlles.Fields("Menge").Value Then
          rsTischAlles.Delete
        End If
      End If
    rsTischAlles.Update 'Aktualisiert das Recordset
    rsTischAlles.Requery 'Aktualisiert die Datenbank

End If
 
 Call TischAbfragen(VarKellner, VarStation, VarTisch)
 Call frmTisch.TischNeueGerichte


Case "Alles"


If rsTischAlles.EOF = True Then
        MsgBox "Storno nicht gefunden"
Else
     If rsTischAlles.Fields("Menge").Value = 1 Then
      rsTischAlles.Delete
     Else
        Wert = InputBox("Geben Sie ein Wert ein.")
        If Wert > 0 And Wert < rsTischAlles.Fields("Menge").Value Then
           rsTischAlles.Fields("Menge").Value = rsTischAlles.Fields("Menge").Value - Wert
        ElseIf Wert = rsTischAlles.Fields("Menge").Value Then
           rsTischAlles.Delete
        End If
     End If
    rsTischAlles.Update 'Aktualisiert das Recordset
    rsTischAlles.Requery 'Aktualisiert die Datenbank
 
   If rsTischNeu.EOF = False Then
      If rsTischNeu.Fields("Menge").Value = 1 Then
        rsTischNeu.Delete
      Else
        If Wert > 0 And Wert < rsTischNeu.Fields("Menge").Value Then
          rsTischNeu.Fields("Menge").Value = rsTischNeu.Fields("Menge").Value - Wert
        ElseIf Wert = rsTischNeu.Fields("Menge").Value Then
         rsTischNeu.Delete
        End If
      End If
    rsTischNeu.Update 'Aktualisiert das Recordset
    rsTischNeu.Requery 'Aktualisiert die Datenbank
   End If
   
End If
  Call frmTisch.TischNeueGerichte
  Call TischAbfragen(VarKellner, VarStation, VarTisch)
    
End Select
    
'frmTisch.dgrTisch.Row = frmTisch.dgrTisch.ApproxCount - 1
Set rsTischAlles = Nothing
Set rsTischNeu = Nothing
Set objConn = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Sub

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

End Sub
Sub TischSumme()
Dim objConn As New ADODB.Connection
Dim rsSummeTisch As New ADODB.Recordset


Dim strPath As String

Set objConn = New ADODB.Connection
Set rsSummeTisch = 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"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

With rsSummeTisch
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Source = "Select Sum(Menge*VP) As SummeTisch FROM OffeneTische Where Station = '" & VarStation & "' and Kellner='" & VarKellner & "' and Tisch='" & VarTisch & "'"
    .Open
End With
  
  IstNullWert = CStr(IsNull(rsSummeTisch("SummeTisch")))

 If IstNullWert = True Then
  frmTisch.dgrTisch.Caption = VarStation & "   " & "Tisch: " & VarTisch & "       " & "Kelner: " & VarKellner
  frmTisch.lblTischSumme.Caption = "Summe: " & "00,00"
  Else
    frmTisch.dgrTisch.Caption = VarStation & "   " & "Tisch: " & VarTisch & "       " & "Kelner: " & VarKellner
    frmTisch.lblTischSumme.Caption = "Summe: " & Format(CStr(rsSummeTisch("SummeTisch")), "Currency")
 End If

   'Formatierung von dgrTisch Tabelle vornehmen
   Set fmt = New StdDataFormat
   fmt.Type = fmtCustom
   fmt.Format = "Currency" '"###,##0.00"
   Set frmTisch.dgrTisch.Columns("E-Preis").DataFormat = fmt
   Set frmTisch.dgrTisch.Columns("G-Preis").DataFormat = fmt
Set objConn = Nothing
Set rsSummeTisch = Nothing
Set fmt = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Sub

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




'---------Tabelle Allgemein öffnen-------------
Sub DatenbankOeffnen(SQlString, GridTabelle)

Set objConn = New ADODB.Connection
Set rsMain = New ADODB.Recordset
Dim strPath As String

  On Error GoTo err_Handler

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

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

  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .ConnectionString = "Data Source=" & strPath & "kasse.mdb"
    .CursorLocation = adUseClient
    .Open
  End With


  With rsMain
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Source = SQlString
    .Open
   End With



  If rsMain.BOF Then
  MsgBox "Artikelnummer nicht gefunden"
  End If 'wenn leer, dann raus
  
  Set GridTabelle.DataSource = rsMain
  
rsMain.Close
objConn.Close
Set rsMain = Nothing
Set objConn = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Sub

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