69 lines
1.8 KiB
Plaintext
69 lines
1.8 KiB
Plaintext
|
|
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 |