Public TheEvent As Integer

Dim CNRAlt As Long


Private Sub BAbwerten_Click()


Dim wert1
Dim Wert As Double
Dim aktLieferscheinnummer
Dim db1 As Database

Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset

aktLieferscheinnummer = TLieferscheinnummer

If OAbgewertet = True Then
 MsgBox "Dieser Lieferschein wurde bereits abgewertet !", vbCritical
 Exit Sub
End If

If OStorniert = True Then
 MsgBox "Ein stornierter Lieferschein kann nicht abgewertet werden !", vbCritical
 Exit Sub
End If

'If TOechsle < CLng(GetParameter("ABWERTUNGOECHSLE")) Then
' MsgBox "Die Abwertung macht keinen Sinn, da Oechsle bereits niedriger", vbCritical
' Exit Sub
'End If

wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?")

If IsNull(wert1) Or wert1 = "" Then
 MsgBox "Sie haben kein gültiges Gewicht eingegeben - Abwertung abgebrochen !", vbCritical
 Exit Sub
End If

If wert1 > 0 Then
 Wert = wert1
 If Wert >= TGewicht Then
  MsgBox ("Gesamte Lieferung abwerten")
  OAbgewertet = True
  TOechsleOriginal = TOechsle
  TQSNROriginal = TQSNR
  'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt
  'If Not IsNull(TSANR) And TSANR <> "" Then
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then
  '   'Keine Oechslereduktion
  '  Else
  '   TOechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'Else
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then
  '   'Keine Oechslereduktion
  '  Else
  '   TOechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'End If
  
  TLieferscheinnummer = TLieferscheinnummer + "A"
  'TQSNR = 1
  'CP 20.11.2011: Änderung auf Qualitätsstufe 5 = 'Wein
  TQSNR = 0
  
 Else
  MsgBox ("Teil der Lieferung abwerten - Neuen Lieferschein erstellen")
  Set db1 = CurrentDb
  Set rs1 = db1.OpenRecordset("TLieferungen")
  Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(TLINR))
  rs1.AddNew

  rs1!MGNR = rs2!MGNR
  rs1!GNR = rs2!GNR
  rs1!RNR = rs2!RNR
  
  rs1!ZNR = rs2!ZNR
  rs1!SNR = rs2!SNR
  If Not IsNull(rs2!SANR) Then
   rs1!SANR = rs2!SANR
  End If
  rs1!Lieferscheinnummer = rs2!Lieferscheinnummer + "A"
  rs1!Datum = rs2!Datum
  rs1!Uhrzeit = rs2!Uhrzeit
  rs1!Anmerkung = rs2!Anmerkung
  rs1!Gerebelt = rs2!Gerebelt
  
  rs1!LINR = DMax("LINR", "TLieferungen") + 1
  rs1!OechsleOriginal = rs2!Oechsle
  rs1!Oechsle = rs2!Oechsle
  
  'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt
  'If Not IsNull(TSANR) And TSANR <> "" Then
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then
  '   'Keine Oechslereduktion
  '   rs1!Oechsle = rs2!Oechsle
  '  Else
  '   rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'Else
  '  If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then
  '   'Keine Oechslereduktion
  '   rs1!Oechsle = rs2!Oechsle
  '  Else
  '   rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE")
  '  End If
  'End If
  
  rs1!Abgewertet = True
  rs1!Gewicht = Wert
  rs1!QSNROriginal = rs2!QSNR
  rs1!QSNR = 0
  'TQSNR = 1
  'CP 20.11.2011: Änderung auf Qualitätsstufe 5 = 'Wein
  'TQSNR = 0
  rs1!Handwiegung = False
  rs1!Storniert = False
  
  'Abschläge kopieren
  Set rs3 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE LINR=" + Format(TLINR))
  Set rs4 = db1.OpenRecordset("TLieferungAbschlag")
  While Not rs3.EOF
    rs4.AddNew
    rs4!LINR = rs1!LINR
    rs4!ASNR = rs3!ASNR
    rs4.Update
    rs3.MoveNext
  Wend
  rs3.Close
  rs4.Close
  
  rs1.Update
  rs1.Close
  rs2.Close
  TGewicht = TGewicht - Wert
 End If
End If

Requery
TLieferscheinnummer.SetFocus
'DoCmd.FindRecord aktLieferscheinnummer, acEntire, , acSearchAll, , acCurrent



End Sub

Private Sub BAbwertenAlt_Click()


Dim wert1
Dim Wert As Double
Dim aktLieferscheinnummer
Dim db1 As Database

Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset

aktLieferscheinnummer = TLieferscheinnummer

If OAbgewertet = True Then
 MsgBox "Dieser Lieferschein wurde bereits abgewertet !", vbCritical
 Exit Sub
End If

If OStorniert = True Then
 MsgBox "Ein stornierter Lieferschein kann nicht abgewertet werden !", vbCritical
 Exit Sub
End If

If TOechsle < CLng(GetParameter("ABWERTUNGOECHSLE")) Then
 MsgBox "Die Abwertung macht keinen Sinn, da Oechsle bereits niedriger", vbCritical
 Exit Sub
End If

wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?")

If IsNull(wert1) Or wert1 = "" Then
 MsgBox "Sie haben kein gültiges Gewicht eingegeben - Abwertung abgebrochen !", vbCritical
 Exit Sub
End If

If wert1 > 0 Then
 Wert = wert1
 If Wert >= TGewicht Then
  MsgBox ("Gesamte Lieferung abwerten")
  OAbgewertet = True
  TOechsleOriginal = TOechsle
  TQSNROriginal = TQSNR
  'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt
  If Not IsNull(TSANR) And TSANR <> "" Then
    If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then
     'Keine Oechslereduktion
    Else
     TOechsle = GetParameter("ABWERTUNGOECHSLE")
    End If
  Else
    If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then
     'Keine Oechslereduktion
    Else
     TOechsle = GetParameter("ABWERTUNGOECHSLE")
    End If
  End If
  
  TLieferscheinnummer = TLieferscheinnummer + "A"
  'TQSNR = 1
  'CP 20.11.2011: Änderung auf Qualitätsstufe 0 = 'Wein
  TQSNR = 0
  
 Else
  MsgBox ("Teil der Lieferung abwerten - Neuen Lieferschein erstellen")
  Set db1 = CurrentDb
  Set rs1 = db1.OpenRecordset("TLieferungen")
  Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(TLINR))
  rs1.AddNew

  rs1!MGNR = rs2!MGNR
  rs1!GNR = rs2!GNR
  rs1!RNR = rs2!RNR
  
  rs1!ZNR = rs2!ZNR
  rs1!SNR = rs2!SNR
  If Not IsNull(rs2!SANR) Then
   rs1!SANR = rs2!SANR
  End If
  rs1!Lieferscheinnummer = rs2!Lieferscheinnummer + "A"
  rs1!Datum = rs2!Datum
  rs1!Uhrzeit = rs2!Uhrzeit
  rs1!Anmerkung = rs2!Anmerkung
  rs1!Gerebelt = rs2!Gerebelt
  
  rs1!LINR = DMax("LINR", "TLieferungen") + 1
  rs1!OechsleOriginal = rs2!Oechsle
  
  'CP 20070213: Oechslsereduktion bei Abwertung nur bedingt
  If Not IsNull(TSANR) And TSANR <> "" Then
    If DFirst("AbwertungInAuszahlungIgnorieren", "TSortenattribute", "SANR='" + TSANR + "'") = True Then
     'Keine Oechslereduktion
     rs1!Oechsle = rs2!Oechsle
    Else
     rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE")
    End If
  Else
    If DFirst("AbwertungInAuszahlungIgnorieren", "TSorten", "SNR='" + TSNR + "'") = True Then
     'Keine Oechslereduktion
     rs1!Oechsle = rs2!Oechsle
    Else
     rs1!Oechsle = GetParameter("ABWERTUNGOECHSLE")
    End If
  End If
  
  rs1!Abgewertet = True
  rs1!Gewicht = Wert
  rs1!QSNROriginal = rs2!QSNR
  rs1!QSNR = 0
  'TQSNR = 1
  'CP 20.11.2011: Änderung auf Qualitätsstufe 0 = 'Wein
  'TQSNR = 0
  rs1!Handwiegung = False
  rs1!Storniert = False
  
  'Abschläge kopieren
  Set rs3 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE LINR=" + Format(TLINR))
  Set rs4 = db1.OpenRecordset("TLieferungAbschlag")
  While Not rs3.EOF
    rs4.AddNew
    rs4!LINR = rs1!LINR
    rs4!ASNR = rs3!ASNR
    rs4.Update
    rs3.MoveNext
  Wend
  rs3.Close
  rs4.Close
  
  rs1.Update
  rs1.Close
  rs2.Close
  TGewicht = TGewicht - Wert
 End If
End If

Requery
TLieferscheinnummer.SetFocus
'DoCmd.FindRecord aktLieferscheinnummer, acEntire, , acSearchAll, , acCurrent



End Sub

Private Sub Befehl114_Click()

Dim Wert

Wert = InputBox("Geben Sie bitte das Gewicht an:", "Manuelle Gewichtseingabe")

If Wert <> "" And Not IsNull(Wert) Then

TGewicht.SetFocus
TGewicht = Wert

OHandwiegung = 1

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll
End If

End Sub



Private Sub Befehl170_Click()

Dim str1 As String
Dim rnr1 As Long

str1 = InputBox("Bitte geben Sie die Riedbezeichnung ein:")

If str1 <> "" And Not IsNull(str1) Then

Dim db1 As Database
Dim rs1 As Recordset

Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * FROM TRiede;")

rs1.AddNew
rnr1 = DMax("[RNR]", "TRiede") + 1
rs1!RNR = rnr1
rs1!GNR = Forms!FLieferungen!TGNR
rs1!Bezeichnung = str1
rs1.Update
rs1.Close
TRNR.Requery
TRNR = rnr1


End If


End Sub

Private Sub Befehl183_Click()

If Not IsNull(TMGNR) And TMGNR <> "" Then
  DoCmd.OpenForm "FMitgliedInfo"
End If

End Sub







Private Sub Befehl194_Click()

End Sub

Private Sub BVorschau_Click()

Dim LieferscheinName As String

If IsNull(GetParameter("LIEFERSCHEINART")) Then
 SetParameter "LIEFERSCHEINART", "2"
End If

LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART")
DoCmd.OpenReport LieferscheinName, acViewPreview, , "[LINR]=" + Format(Forms!FLieferungen!TLINR)

'    If GetParameter("LIEFERSCHEINART") = "1" Then
'      DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR)
'     Else
'      DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR)
'     End If

End Sub

Private Sub Form_Activate()

RefreshAll

End Sub




Private Sub Kombinationsfeld105_Change()

TSNR = TSorte

End Sub



Private Sub Form_Current()

RefreshAll
TMGNR.SetFocus

End Sub

Private Sub Form_Load()
'TOechsle.SetFocus

If Not IsNull(DFirst("LINR", "TLieferungen")) Then
 DoCmd.GoToRecord acActiveDataObject, , acLast
 RefreshAll
Else
 MsgBox ("Keine Lieferungen vorhanden !")
 'Forms!FLieferungen.Close
End If
'TMGNR.SetFocus


End Sub

Private Sub Kombinationsfeld125_Exit(Cancel As Integer)

End Sub



Private Sub LBishergeliefert_DblClick(Cancel As Integer)

Dim LINR1
If Not IsNull(LBishergeliefert) Then
 'TLieferscheinnummer.SetFocus
 LINR1 = LBishergeliefert
 Forms!FLieferungen.RecordSource = "SELECT TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Telefon, TMitglieder.Geschäftsanteile1, TMitglieder.Geschäftsanteile2, TMitglieder.[Aktives Mitglied], TMitglieder.Eintrittsdatum, TMitglieder.Austrittsdatum, TMitglieder.Ort, TMitglieder.Straße, TLieferungen.* FROM TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR WHERE LINR=" + Format(LINR1)
End If

End Sub


Private Sub OSpaetlese_Click()

Dim Oechsle As Long
Dim QSNR As Long
Oechsle = CLng(TOechsle.Value)
QSNR = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(Oechsle) + " AND Bis>=" + Format(Oechsle))

If QSNR = 5 Then
 If OSpaetlese.Value = True Then
  TQSNR = 5
 Else
  TQSNR = 3
 End If
End If

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll


End Sub

Private Sub TCNR_Click()

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
If MsgBox("Soll sich die nachträgliche Chargenzuordnung auch auf die Chargenmengen auswirken?", vbYesNo) Then
 ChargenLieferungenZuordnungÄndern TLINR, CNRAlt, TCNR
End If


End Sub

Private Sub TCNR_GotFocus()
CNRAlt = TCNR
End Sub

Private Sub TGewicht_Exit(Cancel As Integer)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll

End Sub




Private Sub TGNR_Exit(Cancel As Integer)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
RefreshAll
TRNR.Requery

End Sub

Private Sub TMitglied_Click()

TMGNR = TMitglied

End Sub

Private Sub TOechsle_Exit(Cancel As Integer)
        
If IsNull(TOechsle) Or TOechsle = 0 Or TOechsle = "" Then
Else
 TQSNR.Value = DFirst("QSNR", "TQualitaetsstufen", "Von<=" + Format(TOechsle) + " AND Bis>=" + Format(TOechsle))
End If
 DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 RefreshAll

End Sub

Sub RefreshAll()

Dim w1

w1 = TOechsle

If Not IsNull(w1) And w1 <> "" Then
 'TQualitaetsstufe.Caption = DMax("Bezeichnung", "TQualitaetsstufen", "QSNR=" + Format(TQSNR))
 If Qualitätsstufe(CDbl(w1)) = "Spätlese" Then
  OSpaetlese.Visible = True
 Else
  OSpaetlese.Visible = False
 End If
 TKW.Caption = "= " + Format((DMax("[KW]", "TUmrechnung", "Oechsle=" + Format(TOechsle)))) + " ° KW"
Else
 'TQualitaetsstufe.Caption = ""
 TKW.Caption = ""
End If

If Not IsNull(TGNR) Then
 TGLNR = DFirst("[GLNR]", "TGemeinden", "GNR=" + Format(TGNR))
 TWBGNR = GetGebietGLNR(TSNR, TQSNR, TGLNR)
 'TWBGNR = DFirst("[WBGNR]", "TGrosslagen", "GLNR=" + Format(TGLNR))
 TRGNR = DFirst("[RGNR]", "TGebiete", "WBGNR=" + Format(TWBGNR))
End If


LBishergeliefert.Requery

End Sub


Private Sub Befehl133_Click()
On Error GoTo Err_Befehl133_Click


    DoCmd.GoToRecord , , acFirst

Exit_Befehl133_Click:
    Exit Sub

Err_Befehl133_Click:
    MsgBox Err.Description
    Resume Exit_Befehl133_Click
    
End Sub
Private Sub Befehl134_Click()
On Error GoTo Err_Befehl134_Click


    DoCmd.GoToRecord , , acPrevious

Exit_Befehl134_Click:
    Exit Sub

Err_Befehl134_Click:
    MsgBox Err.Description
    Resume Exit_Befehl134_Click
    
End Sub
Private Sub Befehl135_Click()
On Error GoTo Err_Befehl135_Click


    DoCmd.GoToRecord , , acNext

Exit_Befehl135_Click:
    Exit Sub

Err_Befehl135_Click:
    MsgBox Err.Description
    Resume Exit_Befehl135_Click
    
End Sub
Private Sub Befehl136_Click()
On Error GoTo Err_Befehl136_Click


    DoCmd.GoToRecord , , acLast

Exit_Befehl136_Click:
    Exit Sub

Err_Befehl136_Click:
    MsgBox Err.Description
    Resume Exit_Befehl136_Click
    
End Sub
Private Sub Befehl137_Click()

On Error GoTo Err_Befehl137_Click


    DoCmd.GoToRecord , , acNewRec

Exit_Befehl137_Click:
    Exit Sub

Err_Befehl137_Click:
    MsgBox Err.Description
    Resume Exit_Befehl137_Click
    
TMGNR.SetFocus


End Sub
Private Sub Befehl138_Click()

If MsgBox("Sind Sie sicher, daß Sie diesen Datensatz löschen möchten (ev. stornieren) ?", vbYesNo) = vbYes Then

On Error GoTo Err_Befehl138_Click


    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Befehl138_Click:
    Exit Sub

Err_Befehl138_Click:
    MsgBox Err.Description
        Resume Exit_Befehl138_Click
    
    
End If

End Sub

Private Sub Befehl141_Click()

If MsgBox("Wollen Sie diese Lieferung wirklich stornieren ?", vbYesNo) = vbYes Then

 If Not IsNull(TCNR) And TGewicht > 0 And TOechsle > 0 Then
  If MsgBox("Wollen Sie die Liefermenge bei der zugeordneten Charge ebenfalls abziehen?", vbYesNo) = vbYes Then
    ChargeBefuellungRueckgaengig TCNR, TLINR
    TCNR = ""
  End If
 End If
 
 TGewicht = 0
 OStorniert = 1
 DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 RefreshAll
 
End If
    
    
End Sub

Private Sub TSNR_Exit(Cancel As Integer)

Dim SNR1 As String
Dim SANR1 As String


If IsNull(TSNR) Then
 Exit Sub
End If

If GetSNRAndSANRFromInput(TSNR, SNR1, SANR1) Then
 TSNR = SNR1
 TSANR = SANR1
Else
 TSANR = Null
End If

If DCount("[SNR]", "TSorten", "SNR='" + TSNR + "'") = 0 Then
 MsgBox "Bitte geben Sie ein gültiges Sortenkürzel ein!", vbCritical
 'TSNR =
 TSNR.SetFocus
 Exit Sub
End If


    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
    RefreshAll
End Sub



Private Sub Befehl175_Click()

Dim LieferscheinName As String

If GetParameter("LIEFERSCHEINART") = Null Then
 SetParameter "LIEFERSCHEINART", 2
End If

LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART")
DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FLieferungen!TLINR)

'    If GetParameter("LIEFERSCHEINART") = "1" Then
'      DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR)
'     Else
'      DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FLieferungen!TLINR)
'     End If
            
End Sub





Private Sub Befehl186_Click()
    
DoCmd.OpenForm "MLieferungSuchen"
    
End Sub