Attribute VB_Name = "mdlDatenbanken"
'---------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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With


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

 While Not rsStationen.EOF 'Alle Räume laden, positionieren und anzeigen
 VarIndex = rsStationen.AbsolutePosition

'Steuerelement für jeden einzelnen Raum laden

 Load frmLink.cmdStationenLink.Item(VarIndex)
 If VarIndex = 1 Then
    frmLink.cmdStationenLink.Item(VarIndex).Top = 3 * frmLink.lblOberflaecheLink1.Height
 Else
    frmLink.cmdStationenLink.Item(VarIndex).Top = frmLink.cmdStationenLink.Item(VarIndex - 1).Top + frmLink.cmdStationenLink.Item(VarIndex - 1).Height + frmLink.cmdStationenLink.Item(VarIndex - 1).Height / 2
 End If
 'frmLink.cmdStationenLink.Item(VarIndex).Left = (frmLink.picOberflaeche.ScaleWidth - frmLink.cmdStationenLink.Item(VarIndex).Width) / 2
 frmLink.cmdStationenLink.Item(VarIndex).Visible = True
 frmLink.cmdStationenLink.Item(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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With


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

  While Not rsVerwaltung.EOF
 VarIndex = rsVerwaltung.AbsolutePosition

'Alle Räume laden und zeigen sowie Positionieren
 'Element 1

 Load frmLink.cmdVerwaltungLink(VarIndex)
 frmLink.cmdVerwaltungLink(VarIndex).Tag = rsVerwaltung.Fields("Verwaltung").Value
 If VarIndex = 1 Then
 frmLink.cmdVerwaltungLink(VarIndex).Top = 3 * frmLink.lblOberflaecheLink1.Height
 Else
 frmLink.cmdVerwaltungLink(VarIndex).Top = frmLink.cmdVerwaltungLink(VarIndex - 1).Top + frmLink.cmdVerwaltungLink(VarIndex - 1).Height + frmLink.cmdVerwaltungLink(VarIndex - 1).Height / 2
 End If
 'frmLink.cmdVerwaltungLink(VarIndex).Left = (frmLink.ScaleWidth - frmLink.cmdVerwaltungLink(VarIndex).Width) / 2
 frmLink.cmdVerwaltungLink.Item(VarIndex).Caption = rsVerwaltung.Fields("Verwaltung").Value
 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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .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").Value + frmRaum.imgLokal.Top
        frm.picTisch(VarIndex).Left = rsTabellePicTisch.Fields("Links").Value + frmRaum.imgLokal.Left
    Else
        frm.picTisch(VarIndex).Top = rsTabellePicTisch.Fields("Oben").Value
        frm.picTisch(VarIndex).Left = rsTabellePicTisch.Fields("Links").Value
    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).FontName = "Arial"
    frm.picTisch(VarIndex).FontSize = "14"
    'frm.picTisch(VarIndex).FontBold = True
    'frm.picTisch(VarIndex).ForeColor = &H80& '---->Weinrot hell
    'frm.picTisch(VarIndex).ForeColor = &H40& '---->Weinrot dunkel
    frm.picTisch(VarIndex).ForeColor = &H80000012 '---->Schwarz
    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-------------


Public Function TischAbfragensjhsjfwrjrw(VarTisch, VarTischDetails)

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

  

  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=" & VarDatenbank
    .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("Mitarbeiter").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"
       TischAbfragen = True
       Set rsStation = Nothing
       Set rsTisch = Nothing
       Set objConn = Nothing
       Exit Function
     End If
  End If
 rsStation.MoveNext
 Wend
  
  'Überprüfen ob Tisch und station übereinstimmen
  With rsTisch
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    If VarTischDetails = "Alles" Then
     .Open "Select ID,Station,Kellner,Tisch,Stationsdrucker,Bondrucker,PLU,Menge,Gericht,EPREIS AS [E-Preis],GPREIS AS [G-Preis] FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "'"
    Else
     .Open "Select ID,Station,Kellner,Tisch,Stationsdrucker,Bondrucker,PLU,Menge,Gericht,EPREIS AS [E-Preis],GPREIS AS [G-Preis] FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "'and TischDetails='" & VarTischDetails & "'"
    End If
  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 "Dieser Tisch ist von Mitarbeiter  " & VarKellner & " geöffnet"
      TischAbfragen = True
      Set rsStation = Nothing
      Set rsTisch = Nothing
      Set objConn = Nothing
      Exit Function
    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
TischAbfragen = False
 
 Set frmTisch.dgrTisch.DataSource = rsTisch
  
  If VarTischDetails = "Alt" Then
    frmTisch.dgrTisch.BackColor = &H80000018 '&HFFFFFF
    frmTisch.dgrTisch.ForeColor = &H80&
    frmTisch.lblTischSumme.ForeColor = &H80&
    frmTisch.lblTischSumme.BackColor = &H80000018
  ElseIf VarTischDetails = "Neu" Then
    frmTisch.dgrTisch.BackColor = &H80000014
    frmTisch.dgrTisch.ForeColor = &H800000
    frmTisch.lblTischSumme.ForeColor = &H800000
    frmTisch.lblTischSumme.BackColor = &H80000014
  End If
 
 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("Stationsdrucker").Visible = False
 frmTisch.dgrTisch.Columns("Bondrucker").Visible = False

 frmTisch.dgrTisch.Columns("PLU").Width = 0.3 * frmTisch.dgrTisch.Width / 5
 frmTisch.dgrTisch.Columns("Menge").Width = 0.4 * frmTisch.dgrTisch.Width / 5
 frmTisch.dgrTisch.Columns("Gericht").Width = 2.95 * frmTisch.dgrTisch.Width / 5
 frmTisch.dgrTisch.Columns("E-Preis").Width = 0.6 * frmTisch.dgrTisch.Width / 5
 frmTisch.dgrTisch.Columns("G-Preis").Width = 0.6 * frmTisch.dgrTisch.Width / 5
 
   
 frmTisch.dgrTisch.Columns("Menge").Alignment = dbgCenter
 frmTisch.dgrTisch.Columns("E-Preis").Alignment = dbgRight
 frmTisch.dgrTisch.Columns("G-Preis").Alignment = dbgRight

 
   If frmTisch.dgrTisch.Row >= 0 Then
     frmTisch.dgrTisch.Scroll 0, 1000
     frmTisch.dgrTisch.Row = frmTisch.dgrTisch.VisibleRows - 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}"
   End If
 
 
 TischSumme (VarTischDetails)
   

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

End Function























'--------- Stationberechtigung und Tabelle OffeneTische Abfragen-------------
Sub TischAktualisieren(VarTischLokal, VarTischDetails)

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

  

  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=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With
 
 
  With rsTisch
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    
    If VarTischDetails = "Alt" Then
     .Open "Select *FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTischLokal & "' and TischDetails='" & VarTischDetails & "' ORDER BY RegID,ID"
     frmTisch.cmdTisch.Caption = "Alt"
    Else
     .Open "Select *FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTischLokal & "'and TischDetails='" & VarTischDetails & "' ORDER BY RegID,ID "
     frmTisch.cmdTisch.Caption = "Neu"
    End If
  End With

Set frmTisch.dgrTisch.DataSource = rsTisch

'For I = 1 To rsTisch.RecordCount
  'frmTisch.dgrTisch.Row = I - 1
  'If frmTisch.dgrTisch.Columns("Anz").Text = "x" Then
   'frmTisch.dgrTisch.Columns("Anz").Text = ""
   'MsgBox "kjjkjk" 'frmTisch.dgrTisch.Columns("Menge").Value"
  'End If
'Next I
    
    
  
  
  If VarTischDetails = "Alt" Then
    frmTisch.dgrTisch.BackColor = &H80000018 '&HFFFFFF
    frmTisch.dgrTisch.ForeColor = &H80&
    frmTisch.lblTischSumme.ForeColor = &H80&
    frmTisch.lblTischSumme.BackColor = &H80000018
  ElseIf VarTischDetails = "Neu" Then
    frmTisch.dgrTisch.BackColor = &H80000014
    frmTisch.dgrTisch.ForeColor = &H800000
    frmTisch.lblTischSumme.ForeColor = &H800000
    frmTisch.lblTischSumme.BackColor = &H80000014
  End If
 
 
 
 For I = 0 To frmTisch.dgrTisch.Columns.Count - 1
  frmTisch.dgrTisch.Columns.Item(I).Visible = False
 Next I
 
 frmTisch.dgrTisch.Columns("EPREIS").Caption = "E-Preis"
 frmTisch.dgrTisch.Columns("GPREIS").Caption = "G-Preis"
 frmTisch.dgrTisch.Columns("Menge_Text").Caption = "Anz."
 
 frmTisch.dgrTisch.Columns("PLU").Visible = True
 frmTisch.dgrTisch.Columns("Anz.").Visible = True
 frmTisch.dgrTisch.Columns("Gericht").Visible = True
 frmTisch.dgrTisch.Columns("E-Preis").Visible = True
 frmTisch.dgrTisch.Columns("G-Preis").Visible = True

 frmTisch.dgrTisch.LeftCol = 1
 frmTisch.dgrTisch.Columns("PLU").Width = 0.08 * frmTisch.dgrTisch.Width
 frmTisch.dgrTisch.Columns("Anz.").Width = 0.06 * frmTisch.dgrTisch.Width
 frmTisch.dgrTisch.Columns("Anz.").DividerStyle = 0
 frmTisch.dgrTisch.Columns("Gericht").Width = 0.63 * frmTisch.dgrTisch.Width
 frmTisch.dgrTisch.Columns("E-Preis").Width = 0.1 * frmTisch.dgrTisch.Width
 frmTisch.dgrTisch.Columns("G-Preis").Width = 0.1 * frmTisch.dgrTisch.Width

 frmTisch.dgrTisch.Columns("PLU").Alignment = dbgCenter
 frmTisch.dgrTisch.Columns("Anz.").Alignment = dbgCenter
 frmTisch.dgrTisch.Columns("E-Preis").Alignment = dbgRight
 frmTisch.dgrTisch.Columns("G-Preis").Alignment = dbgRight

 'frmTisch.dgrTisch.Columns.Item(1).Alignment.
 
    frmTisch.lblTischSumme.Width = 2 * frmTisch.dgrTisch.Columns("G-Preis").Width + 0.03 * frmTisch.dgrTisch.Width
    frmTisch.lblTischSumme.Top = frmTisch.dgrTisch.Top + frmTisch.dgrTisch.Height
    frmTisch.lblTischSumme.Left = frmTisch.dgrTisch.Left + frmTisch.dgrTisch.Width - frmTisch.lblTischSumme.Width
    frmTisch.lblTischSumme.FontSize = "18"

    frmTisch.cmdTisch.Height = frmTisch.lblTischSumme.Height
    frmTisch.cmdTisch.Top = frmTisch.dgrTisch.Top + frmTisch.dgrTisch.Height + (frmTisch.Height - frmTisch.dgrTisch.Top - frmTisch.dgrTisch.Height) / 2 - frmTisch.cmdTisch.Height / 2
    frmTisch.cmdTisch.Left = frmTisch.lblTischSumme.Left - frmTisch.lblTischSumme.Width

 
   If frmTisch.dgrTisch.Row >= 0 Then
     frmTisch.dgrTisch.Scroll 0, 1000
     frmTisch.dgrTisch.Row = frmTisch.dgrTisch.VisibleRows - 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}"
   End If

  TischSumme (VarTischDetails)
   

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

End Sub

Sub GerichtEintragen(VarPLU, VarStation, VarTisch, VarMenge)
Dim objConn As ADODB.Connection
Dim rsGericht As ADODB.Recordset
Dim rsTisch As ADODB.Recordset

Dim strPath As String

Set objConn = New ADODB.Connection
Set rsGericht = New ADODB.Recordset
Set rsTisch = 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=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With

'Tabelle Artikelgruppe öffnen und Gericht suchen
  With rsGericht
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM Artikelgruppe Where PLU='" & VarPLU & "'"
  End With

   If rsGericht.EOF = True Then
    MsgBox "Gericht nicht gefunden" 'Wenn Gericht nicht vorhanden meldung zeigen und verlassen
    Set rsGericht = Nothing
    Set rsTisch = Nothing
    Set objConn = Nothing
    Exit Sub
   End If  'sonst weiter
    
       
  'Tabelle Tisch öffnen
   With rsTisch
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *FROM OffeneTische Where PLU='" & VarPLU & "' and TischDetails='Neu'"
   End With
    
    
    
    'Tabelle Tisch Daten eintragen
    If rsTisch.EOF = True Then
        'Datensatz wurde nicht gefunden, neues Gericht wird eingetragen
        rsTisch.AddNew
        rsTisch.Fields("Menge").Value = VarMenge
      Else
        'Datensatz gefunden
      
        If rsTisch.Fields("IDWG").Value = "Getränke" Then
         
         rsTisch.Fields("Menge").Value = VarMenge + rsTisch.Fields("Menge")
         Else
         rsTisch.AddNew
         rsTisch.Fields("Menge").Value = VarMenge
        End If
    
    End If
    
    rsTisch.Update
       
    rsTisch.Fields("Kellner").Value = VarKellner
    rsTisch.Fields("Station").Value = VarStation
    rsTisch.Fields("Tisch") = VarTisch
    rsTisch.Fields("TischDetails") = "Neu"
    rsTisch.Fields("Stationsdrucker").Value = rsGericht.Fields("Stationsdrucker").Value
    rsTisch.Fields("Bondrucker").Value = rsGericht.Fields("Bondrucker").Value
    rsTisch.Fields("IDWG").Value = rsGericht.Fields("IDWG").Value
    rsTisch.Fields("WG").Value = rsGericht.Fields("WG").Value
    
    rsTisch.Fields("RegID").Value = rsTisch.Fields("ID").Value
    rsTisch.Fields("Extra").Value = "Nein"
    rsTisch.Fields("Kommentar").Value = "Nein"
    rsTisch.Fields("PLU").Value = rsGericht.Fields("PLU").Value
    rsTisch.Fields("PLU_ID").Value = rsGericht.Fields("PLU").Value
    rsTisch.Fields("Menge_Text").Value = rsTisch.Fields("Menge").Value & "x"
    rsTisch.Fields("Gericht").Value = rsGericht.Fields("Gericht").Value
    rsTisch.Fields("EPREIS").Value = rsGericht.Fields("EPREIS").Value
    rsTisch.Fields("GPREIS").Value = Format(rsTisch.Fields("Menge") * rsGericht.Fields("EPREIS"), "#####0.00")
    
    If Time < "04:00:00" Then
        VarDatumAktuel = CStr(Date - 1)
    Else
        VarDatumAktuel = CStr(Date)
    End If
    rsTisch.Fields("Datum").Value = VarDatumAktuel
    rsTisch.Fields("Zeit") = Time

    
    rsTisch.Update 'Recordset Aktualisieren
    rsTisch.Requery 'Datenbank Aktualisieren

   Call TischAktualisieren(VarTisch, "Neu")
   frmTisch.cmdTisch.Caption = "Neu"

'Objekte aus dem Speicher leeren
Set rsGericht = Nothing
Set rsTisch = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0
Set rsGericht = 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 rsTischNeuesGericht = Nothing
Set objConn = Nothing

End Sub
Sub PreisEintragen(VarDrucker, VarPLU, VarMenge, VarGericht, VarEPREIS)
Dim objConn As ADODB.Connection
Dim rsTischNeuesGericht As ADODB.Recordset
Dim strPath As String

Set objConn = New ADODB.Connection
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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With

        
   'Tabelle TischeNeu öffnen
   With rsTischNeuesGericht
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockOptimistic
     .Open "Select *FROM OffeneTische Where PLU='" & VarPLU & "' and EPREIS='" & VarEPREIS & "' and TischDetails='Neu' "
   End With
    
    'Tabelle TischNeuesGericht Daten eintragen
    If rsTischNeuesGericht.EOF = True Then
        rsTischNeuesGericht.AddNew
        rsTischNeuesGericht.Fields("Menge") = VarMenge
        rsTischNeuesGericht.Fields("Menge_Text").Value = rsTischNeuesGericht.Fields("Menge").Value & "x"

      Else
        'Datensatz Gefunden
         If rsTischNeuesGericht.Fields("IDWG").Value = "Getränke" Then
            VarIDWG = "Getränke"
            rsTischNeuesGericht.Fields("Menge").Value = VarMenge + rsTischNeuesGericht.Fields("Menge")
            rsTischNeuesGericht.Fields("Menge_Text").Value = rsTischNeuesGericht.Fields("Menge").Value & "x"

         Else
            VarIDWG = "Speisen"
            rsTischNeuesGericht.AddNew
            rsTischNeuesGericht.Fields("Menge").Value = VarMenge
            rsTischNeuesGericht.Fields("Menge_Text").Value = rsTischNeuesGericht.Fields("Menge").Value & "x"

        End If
        
    End If
    rsTischNeuesGericht.Update
    
    
    If VarPLU = 998 Then
      VarIDWG = "Getränke"
    Else
      VarIDWG = "Speisen"
    End If

    
    rsTischNeuesGericht.Fields("Kellner").Value = VarKellner
    rsTischNeuesGericht.Fields("Station").Value = VarStation
    rsTischNeuesGericht.Fields("Tisch").Value = VarTisch
    rsTischNeuesGericht.Fields("TischDetails") = "Neu"
    rsTischNeuesGericht.Fields("IDWG").Value = VarIDWG
    rsTischNeuesGericht.Fields("Stationsdrucker").Value = VarDrucker
    rsTischNeuesGericht.Fields("Bondrucker").Value = VarDrucker
    
    rsTischNeuesGericht.Fields("RegID").Value = rsTischNeuesGericht.Fields("ID").Value
    rsTischNeuesGericht.Fields("Extra").Value = "Nein"
    rsTischNeuesGericht.Fields("Kommentar").Value = "Nein"

    rsTischNeuesGericht.Fields("PLU").Value = VarPLU
    rsTischNeuesGericht.Fields("PLU_ID").Value = VarPLU

    rsTischNeuesGericht.Fields("Gericht").Value = VarGericht
 
    rsTischNeuesGericht.Fields("EPreis").Value = Format(VarEPREIS, "####0.00")
    rsTischNeuesGericht.Fields("GPreis").Value = Format(VarEPREIS * rsTischNeuesGericht.Fields("Menge"), "#####0.00")
   

    If Time < "04:00:00" Then
        VarDatumAktuel = CStr(Date - 1)
    Else
        VarDatumAktuel = CStr(Date)
    End If
    
    rsTischNeuesGericht.Fields("Datum").Value = VarDatumAktuel
   
    rsTischNeuesGericht.Fields("Zeit") = Time



    rsTischNeuesGericht.Update 'Recordset Aktualisieren
    rsTischNeuesGericht.Requery 'Datenbank Aktualisieren

   
   Call TischAktualisieren(VarTisch, "Neu")

   frmTisch.cmdTisch.Caption = "Neu"

'Objekte aus dem Speicher leeren


Set rsTischNeuesGericht = Nothing
Set objConn = Nothing

exit_Sub:
  On Error GoTo 0

Set rsTischNeuesGericht = Nothing
Set objConn = Nothing
  
  Exit Sub

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


Set rsTischNeuesGericht = Nothing
Set objConn = Nothing
End Sub
Sub DatensatzStornieren(VarID, VarPLU, VarEPREIS)
Dim Wert As Integer
Dim objConn As ADODB.Connection
Dim rsTisch As ADODB.Recordset
Dim rsStornoTemporaer As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsTisch = New ADODB.Recordset
Set rsStornoTemporaer = 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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With

Select Case frmTisch.cmdTisch.Caption
 Case "Neu"
   
   With rsTisch
     .ActiveConnection = objConn
     '.CursorLocation = adUseClient
     .LockType = adLockPessimistic
     .Open "Select *From OffeneTische Where ID=" & VarID & " and TischDetails='Neu'"
   End With

If Not rsTisch.EOF = True Then
   
   If rsTisch.Fields("Menge").Value = 1 Or rsTisch.Fields("Menge_Text").Value = "" Then
        rsTisch.Delete
   Else
        
        frmTastenBasis.Label1.Caption = "Bitte Anzahl eingeben"
        frmTastenBasis.Show 1 'Anfragefenster öffnen

        If MDIHauptmenu.Tag = "Abbrechen" Then
            MDIHauptmenu.Tag = ""
            Exit Sub 'wenn auf Abbrechen gedruckt wurde gehe raus
        Else
            Wert = MDIHauptmenu.Tag
            MDIHauptmenu.Tag = ""
        End If
                
        If Wert > 0 And Wert < rsTisch.Fields("Menge").Value Then
                rsTisch.Fields("Menge").Value = rsTisch.Fields("Menge").Value - Wert
                rsTisch.Fields("Menge_Text").Value = rsTisch.Fields("Menge").Value & "x"
                rsTisch.Fields("GPREIS").Value = Format(rsTisch.Fields("Menge").Value * rsTisch.Fields("EPreis").Value, "####0.00")
        ElseIf Wert = rsTisch.Fields("Menge").Value Then
            rsTisch.Delete
        End If
   End If
   rsTisch.Update 'Aktualisiert das Recordset
   rsTisch.Requery 'Aktualisiert die Datenbank
End If

Case "Alt"

  With rsTisch
     .ActiveConnection = objConn
     .CursorLocation = adUseClient
     .LockType = adLockPessimistic
     .Open "Select *From OffeneTische Where ID=" & VarID & " and TischDetails='Alt'"
   End With

If Not rsTisch.EOF = True Then
        With rsStornoTemporaer
          .ActiveConnection = objConn
          .CursorLocation = adUseClient
          .LockType = adLockPessimistic
          .Open "Select *From StornosTemporaer Where PLU =  '" & VarPLU & "' and EPREIS =  '" & VarEPREIS & "'"
        End With
  If rsTisch.Fields("Menge").Value = 1 Then
        Wert = 1
        
        If rsStornoTemporaer.EOF Then
              rsStornoTemporaer.AddNew
              WertStorno = Wert
         Else
              WertStorno = Wert + Abs(rsStornoTemporaer.Fields("Menge").Value)
         End If
         
         For I = 1 To rsTisch.Fields.Count - 1
          rsStornoTemporaer.Fields(I).Value = rsTisch.Fields(I).Value
         Next I
         rsTisch.Delete
         
         rsStornoTemporaer.Fields("Menge").Value = -WertStorno
         rsStornoTemporaer.Fields("Menge_Text").Value = "-" & WertStorno & "x"
         rsStornoTemporaer.Fields("Zeit").Value = Format(Time, "hh:mm")
         rsStornoTemporaer.Fields("Kellner").Value = VarKellner
         rsStornoTemporaer.Update
   Else
       
       frmTastenBasis.Label1.Caption = "Bitte Anzahl eingeben"
       frmTastenBasis.Show 1
       
       If MDIHauptmenu.Tag = "Abbrechen" Then
            MDIHauptmenu.Tag = ""
            Exit Sub
       Else
            Wert = MDIHauptmenu.Tag
            MDIHauptmenu.Tag = ""
       End If
       
       If Wert > 0 And Wert < rsTisch.Fields("Menge").Value Then
            
            If rsStornoTemporaer.EOF Then
              rsStornoTemporaer.AddNew
              WertStorno = Abs(Wert)
            Else
              WertStorno = Abs(Wert) + Abs(rsStornoTemporaer.Fields("Menge").Value)
            End If
            
            For I = 1 To rsTisch.Fields.Count - 1
            rsStornoTemporaer.Fields(I).Value = rsTisch.Fields(I).Value
            Next I
           
            rsStornoTemporaer.Fields("Menge").Value = -WertStorno
            rsStornoTemporaer.Fields("Menge_Text").Value = "-" & WertStorno & "x"
            rsStornoTemporaer.Fields("GPREIS").Value = Format(Abs(rsStornoTemporaer.Fields("Menge").Value) * rsStornoTemporaer.Fields("EPreis").Value, "####0.00")
            rsStornoTemporaer.Fields("Zeit").Value = Format(Time, "hh:mm")
            rsStornoTemporaer.Fields("Kellner").Value = VarKellner
            rsStornoTemporaer.Update
            
        
            rsTisch.Fields("Menge").Value = rsTisch.Fields("Menge").Value - Wert
            rsTisch.Fields("Menge_Text").Value = rsTisch.Fields("Menge").Value & "x"
            rsTisch.Fields("GPREIS").Value = Format(rsTisch.Fields("Menge").Value * rsTisch.Fields("EPREIS").Value, "####0.00")
            rsTisch.Update 'Aktualisiert das Recordset
        
        ElseIf Wert = rsTisch.Fields("Menge").Value Then
            
            If rsStornoTemporaer.EOF Then
              rsStornoTemporaer.AddNew
              WertStorno = Abs(Wert)
            Else
              WertStorno = Abs(Wert) + Abs(rsStornoTemporaer.Fields("Menge").Value)
            End If
       
            For I = 1 To rsTisch.Fields.Count - 1
            rsStornoTemporaer.Fields(I).Value = rsTisch.Fields(I).Value
            Next I
            rsTisch.Delete
            
            rsStornoTemporaer.Fields("Menge").Value = -WertStorno
            rsStornoTemporaer.Fields("Menge_Text").Value = "-" & WertStorno & "x"
            rsStornoTemporaer.Fields("GPREIS").Value = Format(Abs(rsStornoTemporaer.Fields("Menge").Value) * rsStornoTemporaer.Fields("EPreis").Value, "####0.00")
            rsStornoTemporaer.Fields("Zeit").Value = Format(Time, "hh:mm")
            rsStornoTemporaer.Fields("Kellner").Value = VarKellner
            rsStornoTemporaer.Update
         End If
     End If
End If


End Select

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

err_Handler:
  If Err.Number <> 13 Then
   MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
  End If
  Resume exit_Sub
Set rsTisch = Nothing
Set rsStornoTemporaer = Nothing
Set objConn = Nothing

End Sub
Sub DatensatzExtraLoeschen(VarRegID)
Dim Wert As Integer
Dim objConn As ADODB.Connection
Dim rsDatensatzExtraLoeschen As ADODB.Recordset
Dim rsStornoTemporaer As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsDatensatzExtraLoeschen = New ADODB.Recordset
Set rsStornoTemporaer = 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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With

   
   With rsDatensatzExtraLoeschen
     .ActiveConnection = objConn
     '.CursorLocation = adUseClient
     .LockType = adLockPessimistic
     .Open "Select *From OffeneTische Where RegID=" & VarRegID & " "
   End With
 
   With rsStornoTemporaer
      .ActiveConnection = objConn
      .CursorLocation = adUseClient
      .LockType = adLockPessimistic
      .Open "Select *From StornosTemporaer"
    End With

  While Not rsDatensatzExtraLoeschen.EOF = True
     rsStornoTemporaer.AddNew
    For I = 1 To rsDatensatzExtraLoeschen.Fields.Count - 1
      rsStornoTemporaer.Fields(I).Value = rsDatensatzExtraLoeschen.Fields(I).Value
    Next I
    
    rsStornoTemporaer.Fields("Menge").Value = -rsStornoTemporaer.Fields("Menge").Value
    rsStornoTemporaer.Fields("Menge_Text").Value = rsStornoTemporaer.Fields("Menge").Value & "x"
    rsStornoTemporaer.Fields("Zeit").Value = Format(Time, "hh:mm")

    rsDatensatzExtraLoeschen.Delete
    rsStornoTemporaer.Update 'Aktualisiert das Recordset
    rsDatensatzExtraLoeschen.Update
    rsDatensatzExtraLoeschen.MoveNext
  Wend

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

err_Handler:
  If Err.Number <> 13 Then
   MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
  End If
  Resume exit_Sub
Set rsDatensatzExtraLoeschen = Nothing
Set rsStornoTemporaer = Nothing
Set objConn = Nothing

End Sub
Sub TischSumme(VarTischDetails)
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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With

With rsSummeTisch
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    If VarTischDetails = "Alt" Then
      .Open "Select Sum(GPREIS) As SummeTisch FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "'"
    Else
      .Open "Select Sum(GPREIS) As SummeTisch FROM OffeneTische Where Station = '" & VarStation & "' and Tisch='" & VarTisch & "' and TischDetails='" & VarTischDetails & "'"
    End If
End With
  
  IstNullWert = CStr(IsNull(rsSummeTisch("SummeTisch")))

 
 If IstNullWert = True Then
  frmTisch.dgrTisch.Caption = VarStation & "   " & "Tisch " & VarTisch
  frmTisch.lblTischSumme.Visible = False
 Else
  frmTisch.dgrTisch.Caption = VarStation & "   " & "Tisch: " & VarTisch
  frmTisch.lblTischSumme.Caption = Format(CStr(rsSummeTisch("SummeTisch")), "Currency")
  frmTisch.lblTischSumme.Visible = True
 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"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .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