Private Sub BSortenKuerzelUmbenennen_Click()

DoCmd.OpenForm "FSortenkuerzelUmbenennen"

End Sub

Private Sub BAutomatischErstellen_Click()

If MsgBox("Wollen Sie Liefermengeneinträge aufgrund der vorhandenen Flächenbindungen automatisch erstellen?", vbYesNo) = vbYes Then
 
 Dim db1 As Database
 Dim rs1 As Recordset
 Dim rs2 As Recordset
 Dim query1 As String
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNR,SANR FROM TFlaechenbindungen WHERE SNR IS NOT NULL AND (Bis>" + Format(year(Date)) + " OR Bis is null)")
 While Not rs1.EOF
   If IsNull(rs1("SANR")) Then
    query1 = "SELECT * FROM TLiefermengen WHERE SNR='" + rs1("SNR") + "' AND SANR IS NULL"
   Else
    query1 = "SELECT * FROM TLiefermengen WHERE SNR='" + rs1("SNR") + "' AND SANR='" + rs1("SANR") + "'"
   End If

   Set rs2 = db1.OpenRecordset(query1)
   
   If rs2.EOF Then
   'there is no entry for this combination
    rs2.AddNew
    rs2("SNR") = rs1("SNR")
    rs2("SANR") = rs1("SANR")
    rs2("ErwarteteLiefermengeProHa") = 7500
    rs2.Update
   End If
   
   rs1.MoveNext
 Wend
 
 rs1.Close
 rs2.Close
 Requery


End If

End Sub

Private Sub Form_Close()

If Not IsNull(TKopftext) Then SetParameter "LIEFERMENGEKOPFTEXT", TKopftext
If Not IsNull(TFusstext) Then SetParameter "LIEFERMENGEFUSSTEXT", TFusstext

End Sub

Private Sub Form_Open(Cancel As Integer)

If Not IsNull(GetParameter("LIEFERMENGEKOPFTEXT")) Then
 TKopftext = GetParameter("LIEFERMENGEKOPFTEXT")
Else
 TKopftext = "Auf Grund der Flächenbindung erwartet der Winzerkeller im Weinviertel reg.Gen.m.b.H. bei der Ernte 2014 von Ihnen eine Lieferung von mindestens"
End If
 
If Not IsNull(GetParameter("LIEFERMENGEKOPFTEXT")) Then
 TFusstext = GetParameter("LIEFERMENGEFUSSTEXT")
Else
 TFusstext = "Bei Nichterfüllung muss mit der im Vertrag vereinbarten Pönnaleforderung gerechnet werden."
End If

End Sub