1486 lines
31 KiB
Plaintext
1486 lines
31 KiB
Plaintext
Public TheEvent As Integer
|
|
Public TimerAus As Boolean
|
|
|
|
Public SerialInterface As Boolean
|
|
Public FreigabeErteilt As Boolean
|
|
|
|
|
|
Private Sub BAbwertenAlt_Click()
|
|
|
|
|
|
Dim wert1 As Variant
|
|
Dim Wert As Double
|
|
Dim aktLieferscheinnummer
|
|
Dim db1 As Database
|
|
|
|
Dim rs1 As Recordset
|
|
Dim rs2 As Recordset
|
|
|
|
aktLieferscheinnummer = TLieferscheinnummer
|
|
|
|
wert1 = InputBox("Welchen Gewichtsanteil dieser Lieferung wollen Sie abwerten ?")
|
|
|
|
If Not IsNull(wert1) And 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 = 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
|
|
rs1!Handwiegung = False
|
|
rs1!Storniert = False
|
|
|
|
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 BChargen_Click()
|
|
|
|
DoCmd.OpenForm "MChargenAuswahl"
|
|
|
|
End Sub
|
|
|
|
Private Sub BDrucken_Click()
|
|
|
|
Dim LieferscheinName As String
|
|
Dim abschlaege1 As Integer
|
|
|
|
abschlaege1 = GetAbschlaege
|
|
|
|
|
|
If GetParameter("LIEFERSCHEINART") = Null Then
|
|
SetParameter "LIEFERSCHEINART", "2"
|
|
End If
|
|
|
|
LieferscheinName = "BLieferschein" + GetParameter("LIEFERSCHEINART")
|
|
|
|
If IsNull(DMax("MGNR", "TMitglieder", "[Aktives Mitglied]=True AND MGNR=Forms!FÜbernahme!TMGNR")) Then
|
|
MsgBox "Bitte zuerst gültiges Mitglied eingeben !", vbCritical
|
|
TMGNR.SetFocus
|
|
Exit Sub
|
|
End If
|
|
|
|
If IsNull(DMax("ZNR", "TZweigstellen", "ZNR=Forms!FÜbernahme!TZweigstelle")) Then
|
|
MsgBox "Bitte zuerst gültige Zweigstelle eingeben !", vbCritical
|
|
TZweigstelle.SetFocus
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
If IsNull(DMax("SNR", "TSorten", "SNR=Forms!FÜbernahme!TSNR")) Then
|
|
MsgBox "Bitte zuerst gültige Sorte eingeben !", vbCritical
|
|
TSNR.SetFocus
|
|
Exit Sub
|
|
End If
|
|
|
|
If IsNull(TGewicht) Or TGewicht = "" Then
|
|
MsgBox "Bitte zuerst wiegen !", vbCritical
|
|
If BWiegen.Enabled Then
|
|
BWiegen.SetFocus
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
|
|
If IsNull(TOechsle) Or TOechsle = "" Then
|
|
MsgBox "Bitte zuerst Oechsle eingeben !", vbCritical
|
|
TOechsle.SetFocus
|
|
Exit Sub
|
|
End If
|
|
|
|
If IsNull(GetParameter("ABSCHLAG_ERFORDERLICH")) Then
|
|
SetParameter "ABSCHLAG_ERFORDERLICH", "0"
|
|
End If
|
|
|
|
If GetParameter("ABSCHLAG_ERFORDERLICH") = "1" And abschlaege1 = 0 Then
|
|
MsgBox "Es muss mindestens ein Abschlag vergeben werden!", vbCritical
|
|
Exit Sub
|
|
End If
|
|
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
|
|
If Not IsNull(TCNR) Then
|
|
If ChargeStandNachFuellung(LINR) > 0 And GetParameter("CHARGENWARNUNG_BEHAELTERVOLL") = "Ja" Then
|
|
If MsgBox("Diese Lieferung würde den Behälter um " + Format(ChargeStandNachFuellung(LINR)) + " überfüllen. Wollen Sie trotzdem diese Lieferung dieser Charge zuordnen und fortsetzen?", vbYesNo) = vbNo Then
|
|
TCNR = Null
|
|
Exit Sub
|
|
|
|
End If
|
|
Else
|
|
If ChargeStandNachFuellung(LINR) > -GetParameter("CHARGENWARNUNG_BEHAELTERFASTVOLL") Then
|
|
MsgBox ("Warnung! Im Behälter der gewählten Charge sind nach dieser Befüllung nur noch " + Format(-ChargeStandNachFuellung(LINR)) + " frei")
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
|
|
TMGNR.SetFocus
|
|
BDrucken.Enabled = False
|
|
|
|
|
|
If Not IsNull(TCNR) Then
|
|
OAufChargeverbucht = ChargeBefuellen(TCNR, TLINR)
|
|
End If
|
|
|
|
If IsNull(TLieferscheinnummer) Or TLieferscheinnummer = "" Then
|
|
'Noch keine Lieferscheinnummer
|
|
|
|
' Switch RTS for 3 seconds -> Waage Freigabe
|
|
|
|
TheEvent = 0
|
|
If GetParameter("STEUERUNGTYP") = "SERIELL" Then
|
|
If XCommSteuerung.PortOpen = 0 Then
|
|
On Error GoTo WeiterNachKippen
|
|
XCommSteuerung.PortOpen = 1
|
|
End If
|
|
End If
|
|
|
|
TimerAus = True
|
|
Kippen (True)
|
|
While TheEvent < 3
|
|
DoEvents
|
|
Wend
|
|
Kippen (False)
|
|
TimerAus = False
|
|
|
|
If GetParameter("STEUERUNGTYP") = "SERIELL" Then
|
|
If XCommSteuerung.PortOpen = 1 Then
|
|
On Error GoTo WeiterNachKippen
|
|
XCommSteuerung.PortOpen = 0
|
|
End If
|
|
End If
|
|
|
|
WeiterNachKippen:
|
|
|
|
On Error Resume Next
|
|
' Lieferscheinnummer setzen
|
|
|
|
SetLieferscheinnummer
|
|
|
|
'Ausdrucken
|
|
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
|
|
|
|
DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
If GetParameter("LIEFERSCHEINART") <> "1" Then
|
|
'2x drucken
|
|
DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
End If
|
|
|
|
|
|
|
|
'If GetParameter("LIEFERSCHEINART") = "1" Then
|
|
' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
'Else
|
|
' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
'End If
|
|
|
|
' new record
|
|
|
|
NewLieferschein
|
|
|
|
|
|
Else
|
|
' Lieferschein bereits 1x gedruckt (kein Kippen, kein neuer Datensatz, keine Lieferscheinnummer
|
|
' nur ausdrucken
|
|
DoCmd.OpenReport LieferscheinName, , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
|
|
'If GetParameter("LIEFERSCHEINART") = "1" Then
|
|
' DoCmd.OpenReport "BLieferschein1", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
'Else
|
|
' DoCmd.OpenReport "BLieferschein2", , , "[LINR]=" + Format(Forms!FÜbernahme!TLINR)
|
|
'End If
|
|
|
|
End If
|
|
|
|
|
|
BDrucken.Enabled = True
|
|
|
|
|
|
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!FÜbernahme!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 Befehl184_Click()
|
|
|
|
|
|
SetLieferscheinnummer
|
|
|
|
End Sub
|
|
|
|
Private Sub Befehl189_Click()
|
|
|
|
If LBishergeliefert.Visible = True Then
|
|
LBishergeliefert.Visible = False
|
|
TLiefersumme.Visible = False
|
|
XSumme1.Visible = False
|
|
XFeld1.Visible = False
|
|
XFeld2.Visible = False
|
|
XFeld3.Visible = False
|
|
XFeld4.Visible = False
|
|
XFeld5.Visible = False
|
|
|
|
Else
|
|
LBishergeliefert.Visible = True
|
|
TLiefersumme.Visible = True
|
|
XSumme1.Visible = True
|
|
XFeld1.Visible = True
|
|
XFeld2.Visible = True
|
|
XFeld3.Visible = True
|
|
XFeld4.Visible = True
|
|
XFeld5.Visible = True
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub BKippen_Click()
|
|
|
|
' Switch RTS for 3 seconds
|
|
|
|
TheEvent = 0
|
|
'MsgBox ("Kippen auslösen")
|
|
Kippen (True)
|
|
While TheEvent < 3
|
|
DoEvents
|
|
Wend
|
|
'MsgBox ("Kippen zurück")
|
|
Kippen (False)
|
|
|
|
End Sub
|
|
|
|
Private Sub BS1_Click()
|
|
|
|
Dim ASNR1 As Long
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
|
|
ASNR1 = BS1.Tag
|
|
|
|
'Check if this ASNR is already assigned
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
|
|
If rs1.recordcount > 0 Then
|
|
Exit Sub
|
|
rs1.Close
|
|
End If
|
|
|
|
'Add to Table TLieferungenAbschlaege
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
|
|
rs1.AddNew
|
|
rs1!LINR = TLINR
|
|
rs1!ASNR = ASNR1
|
|
rs1.Update
|
|
FAbschlaege.Requery
|
|
rs1.Close
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub BS2_Click()
|
|
|
|
Dim ASNR1 As Long
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
|
|
ASNR1 = BS2.Tag
|
|
|
|
'Check if this ASNR is already assigned
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
|
|
If rs1.recordcount > 0 Then
|
|
Exit Sub
|
|
rs1.Close
|
|
End If
|
|
|
|
'Add to Table TLieferungenAbschlaege
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
|
|
rs1.AddNew
|
|
rs1!LINR = TLINR
|
|
rs1!ASNR = ASNR1
|
|
rs1.Update
|
|
FAbschlaege.Requery
|
|
rs1.Close
|
|
|
|
End Sub
|
|
|
|
Private Sub BS3_Click()
|
|
|
|
Dim ASNR1 As Long
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
|
|
ASNR1 = BS3.Tag
|
|
|
|
'Check if this ASNR is already assigned
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
|
|
If rs1.recordcount > 0 Then
|
|
Exit Sub
|
|
rs1.Close
|
|
End If
|
|
|
|
'Add to Table TLieferungenAbschlaege
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
|
|
rs1.AddNew
|
|
rs1!LINR = TLINR
|
|
rs1!ASNR = ASNR1
|
|
rs1.Update
|
|
FAbschlaege.Requery
|
|
rs1.Close
|
|
|
|
End Sub
|
|
|
|
Private Sub BS4_Click()
|
|
|
|
Dim ASNR1 As Long
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
|
|
ASNR1 = BS4.Tag
|
|
|
|
'Check if this ASNR is already assigned
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
|
|
If rs1.recordcount > 0 Then
|
|
Exit Sub
|
|
rs1.Close
|
|
End If
|
|
|
|
'Add to Table TLieferungenAbschlaege
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
|
|
rs1.AddNew
|
|
rs1!LINR = TLINR
|
|
rs1!ASNR = ASNR1
|
|
rs1.Update
|
|
FAbschlaege.Requery
|
|
rs1.Close
|
|
|
|
End Sub
|
|
|
|
Private Sub BWiegen_Click()
|
|
|
|
' Wiegung durchführen
|
|
Dim i As Integer
|
|
Dim countit
|
|
Dim retryvalue
|
|
|
|
Dim Datum As Date
|
|
Dim zeit As Date
|
|
Dim Gewicht As Long
|
|
Dim Waagentext As String
|
|
|
|
TimerAus = True
|
|
|
|
If IsNull(DMax("MGNR", "TMitglieder", "[Aktives Mitglied]=True AND MGNR=Forms!FÜbernahme!TMGNR")) Then
|
|
MsgBox "Bitte zuerst gültiges Mitglied eingeben !", vbCritical
|
|
TMGNR.SetFocus
|
|
Exit Sub
|
|
End If
|
|
|
|
If IsNull(DMax("SNR", "TSorten", "SNR=Forms!FÜbernahme!TSNR")) Then
|
|
MsgBox "Bitte zuerst gültige Sorte eingeben !", vbCritical
|
|
TSNR.SetFocus
|
|
Exit Sub
|
|
End If
|
|
|
|
If GetParameter("UEBERNAME_WIEGENVOROECHSLE") = "0" Then
|
|
If IsNull(TOechsle) Or TOechsle = "" Then
|
|
MsgBox "Bitte zuerst Oechsle eingeben !", vbCritical
|
|
TOechsle.SetFocus
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
|
|
DoCmd.Hourglass True
|
|
TGewicht.SetFocus
|
|
BWiegen.Enabled = False
|
|
|
|
retryvalue = GetParameter("RETRY")
|
|
If IsNull(retryvalue) Or retryvalue = "" Then
|
|
retryvalue = 10
|
|
SetParameter "RETRY", CLng(retryvalue)
|
|
Else
|
|
retryvalue = CLng(retryvalue)
|
|
End If
|
|
|
|
If SerialInterface Then
|
|
If XComm.PortOpen = 0 Then
|
|
On Error GoTo PortOpenError1
|
|
XComm.PortOpen = 1
|
|
End If
|
|
End If
|
|
|
|
countit = 0
|
|
i = -1
|
|
While i < 0 And countit < retryvalue
|
|
If SerialInterface Then
|
|
XComm.InBufferCount = 0
|
|
End If
|
|
i = Wiegen(Datum, zeit, Gewicht, Waagentext)
|
|
countit = countit + 1
|
|
Wend
|
|
|
|
If SerialInterface Then
|
|
XComm.PortOpen = 0
|
|
End If
|
|
|
|
DoCmd.Hourglass False
|
|
|
|
BWiegen.Enabled = True
|
|
If i >= 0 Then
|
|
|
|
If Not IsNull(Datum) And Datum > DateValue("1.1.2000") Then
|
|
TDatum = Datum
|
|
End If
|
|
If Not IsNull(Uhrzeit) And Uhrzeit > TimeValue("3:00") Then
|
|
TUhrzeit = zeit
|
|
End If
|
|
If Not IsNull(Gewicht) Then
|
|
TGewicht.SetFocus
|
|
TGewicht = Gewicht
|
|
Else
|
|
TGewicht = i
|
|
End If
|
|
If Not IsNull(Waagentext) Then
|
|
TWaagentext = Waagentext
|
|
End If
|
|
|
|
OHandwiegung = 0
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
RefreshAll
|
|
Else
|
|
MsgBox "Fehler Nr. " + Format(i) + ": Waage nicht bereit !", vbCritical
|
|
BWiegen.SetFocus
|
|
End If
|
|
|
|
TimerAus = False
|
|
|
|
Exit Sub
|
|
|
|
PortOpenError1:
|
|
MsgBox ("COM Port für Waage nicht verfügbar")
|
|
'BWiegen.Enabled = False
|
|
Exit Sub
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub FAbschlaege_Exit(Cancel As Integer)
|
|
|
|
GetAbschlaege
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
|
|
'RefreshAll
|
|
TCNR.Requery
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
Private Sub Kombinationsfeld105_Change()
|
|
|
|
TSNR = TSorte
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Form_BeforeUpdate(Cancel As Integer)
|
|
|
|
If TLINR <> DMax("LINR", "TLieferungen") And Not IsNull(TLieferscheinnummer) And TLieferscheinnummer <> "" Then
|
|
If MsgBox("Diese Lieferung wurde bereits ausgedruckt ! Sind Sie sicher, dass Sie die Daten ändern möchten ?", vbYesNo) = vbNo Then
|
|
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
|
|
End If
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Close()
|
|
|
|
TimerAus = True
|
|
|
|
LetztenLieferscheinLöschen
|
|
|
|
TheEvent = 10
|
|
|
|
|
|
WiegenBeenden
|
|
|
|
If SerialInterface Then
|
|
If XComm.PortOpen = 1 Then
|
|
XComm.PortOpen = 0
|
|
End If
|
|
If XCommSteuerung.PortOpen = 1 Then
|
|
XCommSteuerung.PortOpen = 0
|
|
End If
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Current()
|
|
|
|
'MsgBox ("BeimAnzeigen")
|
|
RefreshAll
|
|
TMGNR.SetFocus
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Form_Open(Cancel As Integer)
|
|
|
|
TimerAus = False
|
|
Freigabe (True)
|
|
FreigabeErteilt = True
|
|
|
|
SchnellauswahlAnlegen
|
|
NewLieferschein
|
|
RefreshAll
|
|
|
|
'Reihenfolge TOechsle-BWiegen
|
|
If IsNull(GetParameter("UEBERNAME_WIEGENVOROECHSLE")) Then
|
|
SetParameter "UEBERNAME_WIEGENVOROECHSLE", "0"
|
|
End If
|
|
If GetParameter("UEBERNAME_WIEGENVOROECHSLE") = "1" Then
|
|
BWiegen.TabIndex = 8
|
|
TGewicht.TabIndex = 9
|
|
TOechsle.TabIndex = 10
|
|
BDrucken.TabIndex = 11
|
|
End If
|
|
|
|
|
|
WiegenInitialisieren
|
|
|
|
'Serial interface needed?
|
|
If GetParameter("WAAGENTYP") = "L246" Then
|
|
SerialInterface = False
|
|
Else
|
|
SerialInterface = True
|
|
End If
|
|
|
|
'COM Port Waage öffnen
|
|
If SerialInterface Then
|
|
XComm.Settings = GetParameter("WAAGEPORTSETTINGS")
|
|
XComm.CommPort = GetParameter("WAAGEPORT")
|
|
XCommSteuerung.CommPort = GetParameter("STEUERUNGPORT")
|
|
End If
|
|
|
|
'DoCmd.Save acForm, "FÜbernahme"
|
|
'DoCmd.Close acForm, "FÜbernahme", acSaveYes
|
|
|
|
|
|
|
|
If IsNull(GetParameter("UEBERNAHME_WAAGESENDETZUERST")) Then
|
|
SetParameter "UEBERNAHME_WAAGESENDETZUERST", "0"
|
|
End If
|
|
If GetParameter("UEBERNAHME_WAAGESENDETZUERST") = "1" Then
|
|
'port öffnen
|
|
If SerialInterface Then
|
|
If XComm.PortOpen = 0 Then
|
|
On Error GoTo PortOpenError1
|
|
XComm.PortOpen = 1
|
|
End If
|
|
End If
|
|
BWiegen.Enabled = False
|
|
End If
|
|
|
|
If GetParameter("WAAGENMONITOR") = "1" Then
|
|
'port öffnen
|
|
If SerialInterface Then
|
|
If XComm.PortOpen = 0 Then
|
|
On Error GoTo PortOpenError1
|
|
XComm.PortOpen = 1
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
Exit Sub
|
|
|
|
PortOpenError1:
|
|
MsgBox ("COM Port für Waage nicht verfügbar")
|
|
'BWiegen.Enabled = False
|
|
Exit Sub
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Timer()
|
|
|
|
Dim Datum As Date
|
|
Dim zeit As Date
|
|
Dim Gewicht As Long
|
|
Dim Waagentext As String
|
|
Dim gewichtslimit As String
|
|
Dim result As Integer
|
|
|
|
|
|
TheEvent = TheEvent + 1
|
|
|
|
If GetParameter("UEBERNAHME_WAAGESENDETZUERST") = "1" And TimerAus = False Then
|
|
If Forms!FÜbernahme!XComm.InBufferCount > 0 Then
|
|
result = Wiegen(Datum, zeit, Gewicht, Waagentext)
|
|
If result >= 0 Then
|
|
If Not IsNull(Datum) Then
|
|
TDatum = Datum
|
|
End If
|
|
If Not IsNull(Uhrzeit) Then
|
|
TUhrzeit = zeit
|
|
End If
|
|
If Not IsNull(Gewicht) Then
|
|
TGewicht.SetFocus
|
|
TGewicht = Gewicht
|
|
Else
|
|
TGewicht = i
|
|
End If
|
|
If Not IsNull(Waagentext) Then
|
|
TWaagentext = Waagentext
|
|
End If
|
|
OHandwiegung = 0
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
RefreshAll
|
|
Else
|
|
If result <> -9 Then
|
|
MsgBox "Fehler bei Kommunikation mit Waage!", vbCritical
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
gewichtslimit = GetParameter("WAAGENMONITORLIMIT")
|
|
|
|
If GetParameter("WAAGENMONITOR") = "1" And TimerAus = False Then
|
|
result = Wiegen(Datum, zeit, Gewicht, Waagentext, True)
|
|
If result >= 0 Then
|
|
'TTest = Format(result) + ": " + Format(Datum, "dd.mm.yyyy") + " " + Format(zeit, "hh:MM:ss") + " " + Format(Gewicht, "0") + "kg " + waagentext
|
|
TGewichtMonitor = Gewicht
|
|
Else
|
|
'TTest = Format(result)
|
|
End If
|
|
If result >= 0 Then
|
|
If Not IsNull(Gewicht) Then
|
|
If Gewicht >= gewichtslimit Then
|
|
DoCmd.Beep
|
|
|
|
If FreigabeErteilt = True Then
|
|
Freigabe (False)
|
|
FreigabeErteilt = False
|
|
End If
|
|
|
|
|
|
|
|
'If TheEvent Mod 2 = 0 Then
|
|
' Forms!FÜbernahme.Section(0).BackColor = 10874304
|
|
'Else
|
|
Forms!FÜbernahme.Section(0).BackColor = &HFF
|
|
'End If
|
|
Else
|
|
Forms!FÜbernahme.Section(0).BackColor = 10874304
|
|
If FreigabeErteilt = False Then
|
|
Freigabe (True)
|
|
FreigabeErteilt = True
|
|
End If
|
|
|
|
End If
|
|
End If
|
|
Else
|
|
'MsgBox "Fehler bei Kommunikation mit Waage!", vbCritical
|
|
End If
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub LBishergeliefert_DblClick(Cancel As Integer)
|
|
|
|
If Not IsNull(LBishergeliefert) Then
|
|
TLieferscheinnummer.SetFocus
|
|
DoCmd.FindRecord LBishergeliefert, acEntire, , acSearchAll, , acCurrent
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub OAbgewertet_Click()
|
|
|
|
If OAbgewertet = True Then
|
|
If Right(TLieferscheinnummer, 1) <> "A" Then
|
|
TLieferscheinnummer = TLieferscheinnummer + "A"
|
|
End If
|
|
Else
|
|
If Right(TLieferscheinnummer, 1) = "A" Then
|
|
TLieferscheinnummer = Left(TLieferscheinnummer, Len(TLieferscheinnummer) - 1)
|
|
End If
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub OGerebelt_Alt_Click()
|
|
|
|
|
|
'If MsgBox("Soll der entsprechende Gewichtsanteil abgezogen werden ?", vbYesNo) = vbYes Then
|
|
|
|
Dim ra As Double
|
|
Dim gw As Double
|
|
|
|
ra = CDbl(GetParameter("REBELABZUG"))
|
|
|
|
gw = TGewicht
|
|
|
|
|
|
If OGerebelt.Value = False Then
|
|
|
|
gw = gw * (100 - ra) / 100
|
|
|
|
Else
|
|
|
|
gw = gw / (100 - ra) * 100
|
|
|
|
End If
|
|
|
|
|
|
TGewicht = gw
|
|
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
RefreshAll
|
|
|
|
'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 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 TMGNR_Exit(Cancel As Integer)
|
|
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
|
|
End Sub
|
|
|
|
Private Sub TMitglied_Click()
|
|
|
|
TMGNR = TMitglied
|
|
|
|
End Sub
|
|
|
|
Private Sub TMitglied_Exit(Cancel As Integer)
|
|
|
|
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
|
|
|
Dim ort1
|
|
Dim GNR1
|
|
|
|
If Not IsNull(TMGNR) And Not IsNull(TOrt) Then
|
|
|
|
ort1 = TOrt
|
|
If InStr(ort1, " ") > 0 Then
|
|
ort1 = Left(ort1, InStr(ort1, " ") - 1)
|
|
End If
|
|
|
|
GNR1 = DFirst("GNR", "TGemeinden", "Bezeichnung='" + ort1 + "'")
|
|
If Not IsNull(GNR1) Then
|
|
TGNR = GNR1
|
|
Else
|
|
'Voller Ortsname ohne Leerzeichen
|
|
GNR1 = DFirst("GNR", "TGemeinden", "Bezeichnung='" + TOrt + "'")
|
|
If Not IsNull(GNR1) Then
|
|
TGNR = GNR1
|
|
End If
|
|
End If
|
|
|
|
|
|
End If
|
|
|
|
VollieferantenZuschlagEintragen
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub TOechsle_Exit(Cancel As Integer)
|
|
|
|
Dim CNR1 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
|
|
|
|
If Not IsNull(TSNR) And Not IsNull(TQSNR) And Not IsNull(TZweigstelle) Then
|
|
CNR1 = GetActiveCharge(TSNR, TQSNR, TZweigstelle, TSANR)
|
|
If CNR1 > 0 Then
|
|
TCNR = CNR1
|
|
Else
|
|
'Warnung
|
|
If GetParameter("CHARGENWARNUNG") = "Ja" Then
|
|
If MsgBox("Es konnte keine Charge im Status 'Befüllung' für diese Übernahme gefunden werden. Wollen Sie eine Charge auswählen bzw. neu anlegen", vbYesNo) = vbYes Then
|
|
DoCmd.OpenForm ("FUebernahmeChargenauswahl")
|
|
End If
|
|
End If
|
|
End If
|
|
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 TQSNR = 4 Then
|
|
OSpaetlese.Visible = True
|
|
Else
|
|
OSpaetlese.Visible = False
|
|
End If
|
|
TKW.Caption = "= " + Format((DMax("[KW]", "TUmrechnung", "Oechsle=" + Format(TOechsle)))) + " ° KW"
|
|
Else
|
|
TKW.Caption = ""
|
|
End If
|
|
|
|
If Not IsNull(TGNR) Then
|
|
TGLNR = DFirst("[GLNR]", "TGemeinden", "GNR=" + Format(TGNR))
|
|
If Not IsNull(TQSNR) And Not IsNull(TSNR) And Not IsNull(TGLNR) Then
|
|
TWBGNR = GetGebietGLNR(TSNR, TQSNR, TGLNR)
|
|
TRGNR = DFirst("[RGNR]", "TGebiete", "WBGNR=" + Format(TWBGNR))
|
|
End If
|
|
|
|
'TWBGNR = DFirst("[WBGNR]", "TGrosslagen", "GLNR=" + Format(TGLNR))
|
|
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 TSANR_Click()
|
|
|
|
'If TSANR.Column(1) = "Sekt" Then
|
|
' TQSNR = 0
|
|
'End If
|
|
|
|
End Sub
|
|
|
|
Private Sub TSNR_Exit(Cancel As Integer)
|
|
|
|
|
|
TSNR = UCase(TSNR)
|
|
|
|
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
|
|
|
|
|
|
Dim mgnr1
|
|
Dim flageb1
|
|
|
|
mgnr1 = TMGNR
|
|
SNR1 = TSNR
|
|
|
|
If IsNull(SNR1) Or IsNull(mgnr1) Then
|
|
Exit Sub
|
|
End If
|
|
|
|
flageb1 = DSum("Flaeche", "TFlaechenbindungen", "SNR='" + Format(SNR1) + "' AND MGNR=" + Format(mgnr1))
|
|
|
|
If Not IsNull(flageb1) And flageb1 > 0 Then
|
|
OGebunden = True
|
|
Else
|
|
OGebunden = False
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
Sub SetLieferscheinnummer()
|
|
|
|
Dim newLieferscheinnummer As String
|
|
Dim tag1 As String
|
|
Dim mon1 As String
|
|
Dim Jahr1 As String
|
|
Dim temp1
|
|
Dim lief1 As String
|
|
Dim zwst1 As String
|
|
|
|
tag1 = Format(Day(TDatum.Value), "00")
|
|
mon1 = Format(Month(TDatum.Value), "00")
|
|
Jahr1 = Format(year(TDatum.Value), "0000")
|
|
|
|
'MsgBox ("[Datum]=DateValue('" + Format(TDatum, "dd.mm.yyyy") + "')")
|
|
temp1 = DCount("[LINR]", "TLieferungen", "[Datum]=DateValue('" + Format(TDatum, "dd.mm.yyyy") + "') AND TLieferungen.ZNR=" + Format(TZweigstelle))
|
|
If IsNull(temp1) Then
|
|
lief1 = Format(1, "000")
|
|
Else
|
|
lief1 = Format(temp1, "000")
|
|
End If
|
|
|
|
zwst1 = DMax("[Kennbst]", "TZweigstellen", "ZNR=" + Format(TZweigstelle))
|
|
|
|
newLieferscheinnummer = Jahr1 + mon1 + tag1 + zwst1 + lief1
|
|
|
|
TLieferscheinnummer = newLieferscheinnummer
|
|
|
|
End Sub
|
|
|
|
|
|
Public Sub send(ByVal b As Byte)
|
|
' Sends 1 Byte to serial interface
|
|
Dim buff As Variant
|
|
ReDim buff(0 To 0) As Byte
|
|
|
|
buff(0) = b
|
|
|
|
Forms!FÜbernahme!XComm.Output = buff
|
|
|
|
While Forms!FÜbernahme!XComm.OutBufferCount > 0
|
|
Wend
|
|
|
|
End Sub
|
|
|
|
Public Function Receive() As Integer
|
|
' Receives 1 byte from serial interface
|
|
' Timeout after 'MPreferences.ICommTimeout' milliseconds
|
|
|
|
Dim i As Variant
|
|
|
|
On Error GoTo err1
|
|
Forms!FÜbernahme!XComm.InputLen = 1
|
|
TheEvent = 0
|
|
|
|
While Forms!FÜbernahme!XComm.InBufferCount < 1 And TheEvent < 1
|
|
DoEvents
|
|
If Forms!FÜbernahme.ActiveControl = False Then
|
|
Exit Function
|
|
End If
|
|
Wend
|
|
ReDim i(1)
|
|
|
|
If Forms!FÜbernahme!XComm.InBufferCount >= 1 Then
|
|
i = Forms!FÜbernahme!XComm.Input
|
|
'MsgBox (i(0))
|
|
Receive = i(0)
|
|
Else
|
|
Receive = -1
|
|
End If
|
|
Exit Function
|
|
|
|
err1:
|
|
Receive = -1
|
|
|
|
End Function
|
|
|
|
|
|
|
|
|
|
Private Sub Befehl186_Click()
|
|
|
|
DoCmd.OpenForm "MLieferungSuchen"
|
|
|
|
End Sub
|
|
|
|
Sub NewLieferschein()
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim rs2 As Recordset
|
|
Dim LINR1 As Long
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("TLieferungen")
|
|
rs1.AddNew
|
|
If IsNull(DMax("LINR", "TLieferungen")) Then
|
|
rs1!LINR = 1
|
|
Else
|
|
rs1!LINR = DMax("LINR", "TLieferungen") + 1
|
|
'rs1!ZNR = DMax("[ZNR]", "TLieferungen", "[LINR]=" + Format(DMax("[LINR]", "TLieferungen", "[LINR]<>" + Format(rs1!LINR))))
|
|
rs1!ZNR = GetParameter("LETZTEZNR")
|
|
rs1!Gerebelt = DMax("[Gerebelt]", "TLieferungen", "[LINR]=" + Format(DMax("[LINR]", "TLieferungen", "[LINR]<>" + Format(rs1!LINR))))
|
|
End If
|
|
LINR1 = rs1!LINR
|
|
rs1!Datum = Date
|
|
rs1!Uhrzeit = time
|
|
rs1.Update
|
|
rs1.Close
|
|
|
|
' Standardabschläge suchen
|
|
On Error GoTo EndNew
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TAbschlaege WHERE Standard=TRUE")
|
|
Set rs2 = db1.OpenRecordset("TLieferungAbschlag")
|
|
While Not rs1.EOF
|
|
rs2.AddNew
|
|
rs2!LINR = LINR1
|
|
rs2!ASNR = rs1!ASNR
|
|
rs2.Update
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
rs2.Close
|
|
|
|
EndNew:
|
|
Requery
|
|
DoCmd.GoToRecord acActiveDataObject, , acLast
|
|
|
|
End Sub
|
|
|
|
Sub LetztenLieferscheinLöschen()
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim LINR1
|
|
|
|
LINR1 = DMax("LINR", "TLieferungen")
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
|
rs1.MoveLast
|
|
|
|
If rs1!Gewicht = 0 Or IsNull(rs1!Gewicht) Then
|
|
LINR1 = rs1!LINR
|
|
rs1.Delete
|
|
db1.Execute ("DELETE * FROM TLieferungAbschlag WHERE LINR=" + Format(LINR1))
|
|
End If
|
|
rs1.Close
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub TZweigstelle_Exit(Cancel As Integer)
|
|
|
|
If Not IsNull(TZweigstelle) Then
|
|
SetParameter "LETZTEZNR", TZweigstelle
|
|
End If
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Function GetAbschlaege() As Integer
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim str1 As String
|
|
|
|
str1 = ""
|
|
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR WHERE LINR = " + Format(TLINR))
|
|
GetAbschlaege = rs1.recordcount
|
|
While Not rs1.EOF
|
|
str1 = str1 + rs1!Bezeichnung
|
|
rs1.MoveNext
|
|
If Not rs1.EOF Then
|
|
str1 = str1 + Chr(13) + Chr(10)
|
|
End If
|
|
Wend
|
|
rs1.Close
|
|
|
|
TAbschlaege = str1
|
|
|
|
|
|
End Function
|
|
|
|
Sub SchnellauswahlAnlegen()
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim max1 As Long
|
|
Dim i, j As Long
|
|
Dim bs_name As String
|
|
|
|
max1 = 4 ' derzeit 4 Buttons
|
|
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TAbschlaege WHERE Schnellauswahl=True")
|
|
i = 0
|
|
While Not rs1.EOF And i < max1
|
|
str1 = str1 + rs1!Bezeichnung
|
|
bs_name = "BS" + Format(i + 1, "0")
|
|
Controls(bs_name).Visible = True
|
|
Controls(bs_name).Caption = rs1!Bezeichnung
|
|
Controls(bs_name).Tag = rs1!ASNR
|
|
i = i + 1
|
|
rs1.MoveNext
|
|
Wend
|
|
rs1.Close
|
|
For j = i To max1 - 1
|
|
bs_name = "BS" + Format(j + 1, "0")
|
|
Controls(bs_name).Visible = False
|
|
Next j
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Sub VollieferantenZuschlagEintragen()
|
|
|
|
Dim db1 As Database
|
|
Dim rs1 As Recordset
|
|
Dim ASNR1 As Long
|
|
|
|
max1 = 4 ' derzeit 4 Buttons
|
|
|
|
If Not IsNull(TMGNR) Then
|
|
If DFirst("Volllieferant", "TMitglieder", "MGNR=" + Format(TMGNR)) = True Then
|
|
|
|
If Not IsNull(DFirst("ASNR", "TAbschlaege", "Bezeichnung='Treuebonus'")) Then
|
|
ASNR1 = DFirst("ASNR", "TAbschlaege", "Bezeichnung='Treuebonus'")
|
|
Set db1 = CurrentDb
|
|
|
|
'Check if this ASNR is already assigned
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag WHERE ASNR=" + Format(ASNR1) + " AND LINR=" + Format(TLINR))
|
|
If rs1.recordcount > 0 Then
|
|
Exit Sub
|
|
rs1.Close
|
|
End If
|
|
|
|
'Add to Table TLieferungenAbschlaege
|
|
Set db1 = CurrentDb
|
|
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungAbschlag")
|
|
rs1.AddNew
|
|
rs1!LINR = TLINR
|
|
rs1!ASNR = ASNR1
|
|
rs1.Update
|
|
FAbschlaege.Requery
|
|
rs1.Close
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
|
|
|
|
|
|
End Sub
|
|
|