wgmaster: Move vba/ to wgmaster repository
This commit is contained in:
@ -1,522 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Sub GebundenBerechnen(Jahr1 As Long, SortenattributeBeiFlächenbindungOptional As Boolean, GebundenBerücksichtigen As Boolean)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
Dim rs3 As Recordset
|
||||
|
||||
Dim actMGNR As Long
|
||||
Dim actSNR As String
|
||||
Dim actSANR As String
|
||||
Dim rsSANR As String
|
||||
Dim actLieferrecht As Double
|
||||
Dim actLieferrecht_Attribute(0 To 255) As Double
|
||||
Dim actLieferungGebunden As Double
|
||||
Dim actBetrag As Double
|
||||
Dim GewichtGebunden As Double
|
||||
Dim GewichtGebundenGrundsorte As Double
|
||||
Dim test1
|
||||
|
||||
|
||||
Dim ErgebnisGewicht As Double
|
||||
Dim ErgebnisBetrag As Double
|
||||
Dim ErgebnisGebunden As Double
|
||||
Dim ErgebnisDatensaetze As Double
|
||||
Dim ErgebnisAktDatensatz As Double
|
||||
|
||||
Dim query1 As String
|
||||
Dim query2 As String
|
||||
Dim zwi
|
||||
Dim maxertrag As Double
|
||||
Dim KgProHa
|
||||
Dim attribute_count As Long
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim ImmerUngebunden As Boolean
|
||||
|
||||
|
||||
|
||||
DoCmd.Hourglass True
|
||||
|
||||
|
||||
'maxertrag = GetParameter("MAXERTRAG")
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
query1 = "SELECT * FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(Jahr1) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR;"
|
||||
'query1 = "SELECT * FROM (TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR) LEFT JOIN TSortenAttribute ON TLieferungen.SANR = TSortenAttribute.SANR WHERE Oechsle>0 AND TLieferungen.SNR>'' AND Year([Datum]) = " + Format(jahr1) + " ORDER BY TLieferungen.MGNR, TLieferungen.SNR, TLieferungen.SANR DESC, TLieferungen.LINR;"
|
||||
Set rs1 = db1.OpenRecordset(query1)
|
||||
|
||||
actMGNR = -1
|
||||
actSNR = ""
|
||||
actSANR = ""
|
||||
|
||||
|
||||
While Not rs1.EOF
|
||||
|
||||
rs1.Edit
|
||||
|
||||
If actMGNR <> rs1![TLieferungen.MGNR] Then
|
||||
' Nächstes Mitglied
|
||||
actMGNR = rs1![TLieferungen.MGNR]
|
||||
actSNR = "----"
|
||||
actSANR = "----"
|
||||
End If
|
||||
|
||||
If Not IsNull(rs1![SANR]) And rs1!SANR <> "" Then
|
||||
rsSANR = UCase(rs1![SANR])
|
||||
ImmerUngebunden = DFirst("ImmerUngebunden", "TSortenAttribute", "SANR='" + rsSANR + "'")
|
||||
Else
|
||||
rsSANR = ""
|
||||
ImmerUngebunden = False
|
||||
End If
|
||||
|
||||
GewichtGebunden = 0
|
||||
GewichtGebundenGrundsorte = 0
|
||||
|
||||
If SortenattributeBeiFlächenbindungOptional = True Then
|
||||
|
||||
'A Sortenattribute in Flaechenbindung optional
|
||||
|
||||
actSANR = rsSANR
|
||||
|
||||
'Feststellen der Lieferrechte bei Sortenwechsel
|
||||
If actSNR <> UCase(rs1![TLieferungen.SNR]) Then
|
||||
|
||||
actSNR = UCase(rs1![TLieferungen.SNR])
|
||||
|
||||
KgProHa = DFirst("kgproHa", "TSorten", "SNR='" + actSNR + "'")
|
||||
|
||||
'maxertrag für Grundsorte bestimmen
|
||||
If Not IsNull(KgProHa) And KgProHa > 0 Then
|
||||
maxertrag = KgProHa
|
||||
Else
|
||||
maxertrag = GetParameter("MAXERTRAG")
|
||||
End If
|
||||
|
||||
'Lieferrecht für Grundsorte errechnen
|
||||
zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))")
|
||||
If IsNull(zwi) Then
|
||||
actLieferrecht = 0
|
||||
zwi = 0
|
||||
Else
|
||||
actLieferrecht = zwi * maxertrag / 10000
|
||||
End If
|
||||
|
||||
'maxertrag für jedes Attribut bestimmen
|
||||
Set rs3 = db1.OpenRecordset("SELECT * FROM TSortenattribute ORDER BY SANR")
|
||||
i = 0
|
||||
While Not rs3.EOF
|
||||
KgProHa = rs3("kgproha")
|
||||
If Not IsNull(KgProHa) And KgProHa > 0 Then
|
||||
actLieferrecht_Attribute(i) = zwi * KgProHa / 10000
|
||||
Else
|
||||
actLieferrecht_Attribute(i) = zwi * GetParameter("MAXERTRAG") / 10000
|
||||
End If
|
||||
rs3.MoveNext
|
||||
i = i + 1
|
||||
Wend
|
||||
rs3.Close
|
||||
attribute_count = i
|
||||
End If
|
||||
|
||||
|
||||
If rs1!QSNR >= 3 And (rs1!gebunden = True Or GebundenBerücksichtigen = False) Then
|
||||
|
||||
If actSANR = "" Then
|
||||
'Grundsorte
|
||||
|
||||
If rs1!Gewicht < actLieferrecht Then
|
||||
' Alles
|
||||
GewichtGebunden = rs1!Gewicht
|
||||
actLieferrecht = actLieferrecht - GewichtGebunden
|
||||
|
||||
'auch für alle Attribute Lieferrecht reduzieren
|
||||
For i = 0 To attribute_count - 1
|
||||
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
||||
Next i
|
||||
|
||||
Else
|
||||
If actLieferrecht > 0 Then
|
||||
' Ein Teil
|
||||
GewichtGebunden = actLieferrecht
|
||||
actLieferrecht = 0
|
||||
'auch für alle Attribute Lieferrecht reduzieren
|
||||
For i = 0 To attribute_count - 1
|
||||
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
||||
Next i
|
||||
|
||||
Else
|
||||
' Kein geb. Lieferrecht mehr übrig
|
||||
GewichtGebunden = 0
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
'Sortenattribut
|
||||
|
||||
'Nur wenn Attribut nicht ohnehin Ungebunden
|
||||
If ImmerUngebunden = False Then
|
||||
|
||||
'richtigen Eintrag finden
|
||||
Set rs3 = db1.OpenRecordset("SELECT * FROM TSortenattribute ORDER BY SANR")
|
||||
j = 0
|
||||
While Not rs3.EOF And rs3("SANR") <> actSANR
|
||||
rs3.MoveNext
|
||||
j = j + 1
|
||||
Wend
|
||||
rs3.Close
|
||||
If j > attribute_count Then
|
||||
'error
|
||||
MsgBox ("Fehler bei Attributen!")
|
||||
End If
|
||||
|
||||
If rs1!Gewicht < actLieferrecht_Attribute(j) Then
|
||||
' Alles
|
||||
GewichtGebunden = rs1!Gewicht
|
||||
actLieferrecht = actLieferrecht - GewichtGebunden
|
||||
|
||||
'auch für alle Attribute Lieferrecht reduzieren
|
||||
For i = 0 To attribute_count - 1
|
||||
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
||||
Next i
|
||||
|
||||
Else
|
||||
If actLieferrecht_Attribute(j) > 0 Then
|
||||
' Ein Teil
|
||||
GewichtGebunden = actLieferrecht_Attribute(j)
|
||||
'Lieferrecht bei Grundsorte reduzieren
|
||||
actLieferrecht = actLieferrecht - GewichtGebunden
|
||||
'auch für alle Attribute Lieferrecht reduzieren
|
||||
For i = 0 To attribute_count - 1
|
||||
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebunden
|
||||
Next i
|
||||
|
||||
Else
|
||||
' Kein geb. Lieferrecht mehr übrig
|
||||
GewichtGebunden = 0
|
||||
End If
|
||||
End If
|
||||
|
||||
'Versuche, Rest auf Grundsorte zu verbuchen
|
||||
If GewichtGebunden < rs1!Gewicht And actLieferrecht > 0 Then
|
||||
|
||||
If rs1!Gewicht - GewichtGebunden < actLieferrecht Then
|
||||
' Alles
|
||||
GewichtGebundenGrundsorte = rs1!Gewicht - GewichtGebunden
|
||||
actLieferrecht = actLieferrecht - GewichtGebundenGrundsorte
|
||||
|
||||
'auch für alle Attribute Lieferrecht reduzieren
|
||||
For i = 0 To attribute_count - 1
|
||||
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebundenGrundsorte
|
||||
Next i
|
||||
|
||||
Else
|
||||
If actLieferrecht > 0 Then
|
||||
' Ein Teil
|
||||
GewichtGebundenGrundsorte = actLieferrecht
|
||||
actLieferrecht = 0
|
||||
'auch für alle Attribute Lieferrecht reduzieren
|
||||
For i = 0 To attribute_count - 1
|
||||
actLieferrecht_Attribute(i) = actLieferrecht_Attribute(i) - GewichtGebundenGrundsorte
|
||||
Next i
|
||||
|
||||
Else
|
||||
' Kein geb. Lieferrecht mehr übrig
|
||||
GewichtGebundenGrundsorte = 0
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
Else
|
||||
' Kein Qualitätswein
|
||||
GewichtGebunden = 0
|
||||
End If
|
||||
|
||||
|
||||
'MsgBox (Format(rs1!Gewicht) + " " + Format(rs1!Gebunden) + " " + Format(GewichtGebunden))
|
||||
|
||||
If IsNull(GewichtGebunden) Then GewichtGebunden = 0
|
||||
If IsNull(GewichtGebundenGrundsorte) Then GewichtGebundenGrundsorte = 0
|
||||
|
||||
'rounding
|
||||
If CLng(GewichtGebunden) < GewichtGebunden Then
|
||||
GewichtGebunden = CLng(GewichtGebunden) + 1
|
||||
Else
|
||||
GewichtGebunden = CLng(GewichtGebunden)
|
||||
End If
|
||||
GewichtGebundenGrundsorte = Int(GewichtGebundenGrundsorte)
|
||||
|
||||
|
||||
rs1!BGewichtGebunden = GewichtGebunden
|
||||
rs1!BGewichtGebundenGrundsorte = GewichtGebundenGrundsorte
|
||||
|
||||
rs1.Update
|
||||
|
||||
|
||||
Else
|
||||
'B Strikt = Sortenattribute in Flaechenbindung NICHT optional
|
||||
|
||||
'Feststellen der Lieferrechte bei Sorten oder Attributswechsel
|
||||
If actSNR <> UCase(rs1![TLieferungen.SNR]) Or (actSANR <> rsSANR) Then
|
||||
' Nächste Sorte oder Attribut
|
||||
actSNR = UCase(rs1![TLieferungen.SNR])
|
||||
actSANR = rsSANR
|
||||
|
||||
'maxertrag setzen
|
||||
If actSANR <> "" Then
|
||||
'from Sortenattribut
|
||||
KgProHa = DFirst("kgproHa", "TSortenattribute", "SANR='" + rsSANR + "'")
|
||||
If Not IsNull(KgProHa) And KgProHa > 0 Then
|
||||
maxertrag = KgProHa
|
||||
Else
|
||||
maxertrag = GetParameter("MAXERTRAG")
|
||||
End If
|
||||
zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND SANR='" + actSANR + "' AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") * maxertrag / 10000
|
||||
Else
|
||||
'from Sorte
|
||||
If Not IsNull(rs1!KgProHa) And rs1!KgProHa > 0 Then
|
||||
maxertrag = rs1!KgProHa
|
||||
Else
|
||||
maxertrag = GetParameter("MAXERTRAG")
|
||||
End If
|
||||
zwi = DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(actMGNR) + " AND SNR='" + Format(actSNR) + "' AND (Isnull(SANR) or SANR='') AND [Von]<=" + Format(Jahr1) + " AND (Bis>=" + Format(Jahr1) + " OR Isnull(Bis))") * maxertrag / 10000
|
||||
End If
|
||||
|
||||
|
||||
If IsNull(zwi) Then
|
||||
actLieferrecht = 0
|
||||
Else
|
||||
actLieferrecht = zwi
|
||||
End If
|
||||
actLieferungGebunden = 0
|
||||
End If
|
||||
|
||||
' actLieferungGewicht
|
||||
|
||||
|
||||
|
||||
'Wieviel ist gebunden ?
|
||||
|
||||
|
||||
If rs1!QSNR >= 3 And (rs1!gebunden = True Or GebundenBerücksichtigen = False) And ImmerUngebunden = False Then
|
||||
|
||||
If rs1!Gewicht < actLieferrecht - actLieferungGebunden Then
|
||||
' Alles
|
||||
GewichtGebunden = rs1!Gewicht
|
||||
actLieferungGebunden = actLieferungGebunden + GewichtGebunden
|
||||
Else
|
||||
If actLieferungGebunden < actLieferrecht Then
|
||||
' Ein Teil
|
||||
GewichtGebunden = actLieferrecht - actLieferungGebunden
|
||||
actLieferungGebunden = actLieferrecht
|
||||
Else
|
||||
' Kein geb. Lieferrecht mehr übrig
|
||||
GewichtGebunden = 0
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
' Kein Qualitätswein
|
||||
GewichtGebunden = 0
|
||||
End If
|
||||
|
||||
|
||||
'MsgBox (Format(rs1!Gewicht) + " " + Format(rs1!Gebunden) + " " + Format(GewichtGebunden))
|
||||
|
||||
If IsNull(GewichtGebunden) Then GewichtGebunden = 0
|
||||
|
||||
'round up
|
||||
If CLng(GewichtGebunden) < GewichtGebunden Then
|
||||
GewichtGebunden = CLng(GewichtGebunden) + 1
|
||||
Else
|
||||
GewichtGebunden = CLng(GewichtGebunden)
|
||||
End If
|
||||
|
||||
rs1!BGewichtGebunden = GewichtGebunden
|
||||
rs1!BGewichtGebundenGrundsorte = 0
|
||||
rs1.Update
|
||||
|
||||
End If
|
||||
|
||||
rs1.MoveNext
|
||||
|
||||
Wend
|
||||
|
||||
rs1.Close
|
||||
|
||||
|
||||
|
||||
DoCmd.Hourglass False
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
Sub Auszahlung2015_MwStUmstellen()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
Dim faktor As Double
|
||||
Dim Buchführend As Boolean
|
||||
Dim summe1 As Double
|
||||
Dim summe2 As Double
|
||||
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. originaldaten sichern
|
||||
db1.Execute ("DROP TABLE xTempLieferungen")
|
||||
db1.Execute ("CREATE TABLE xTempLieferungen (LINR Integer, MGNR Integer, BTeilzahlung1 DOUBLE, BBetragGebunden DOUBLE, BBetragUngebunden DOUBLE,BTeilzahlung1_neu DOUBLE, BBetragGebunden_neu DOUBLE, BBetragUngebunden_neu DOUBLE, Korrekturbetrag DOUBLE,GesamtBrutto DOUBLE, GesamtBrutto_neu DOUBLE, GesamtBrutto_neu_korrigiert DOUBLE)")
|
||||
db1.Execute ("DELETE * FROM xTempLieferungen")
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TLieferungen where datum>Datevalue('01.01.2015') order by LINR")
|
||||
Set rs2 = db1.OpenRecordset("xTempLieferungen")
|
||||
|
||||
While Not rs1.EOF
|
||||
rs2.AddNew
|
||||
rs2("LINR") = rs1("LINR")
|
||||
rs2("MGNR") = rs1("MGNR")
|
||||
rs2("BTeilzahlung1") = rs1("BTeilzahlung1")
|
||||
rs2("BBetragGebunden") = rs1("BBetragGebunden")
|
||||
rs2("BBetragUngebunden") = rs1("BBetragUngebunden")
|
||||
rs2.Update
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
rs2.Close
|
||||
|
||||
'2. nettobeträge korrigieren
|
||||
Set rs1 = db1.OpenRecordset("SELECT TLieferungen.* FROM TLieferungen WHERE MGNR>0 AND datum>Datevalue('01.01.2015') order by LINR")
|
||||
While Not rs1.EOF
|
||||
Buchführend = DFirst("Buchführend", "TMitglieder", "MGNR=" + Format(rs1("MGNR")))
|
||||
'If buchführend Then
|
||||
' faktor = 1
|
||||
'Else
|
||||
faktor = 1.13 / 1.12
|
||||
'End If
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE LINR=" + Format(rs1("LINR")))
|
||||
rs2.Edit
|
||||
rs2("BTeilzahlung1_neu") = rs1("BTeilzahlung1") * faktor
|
||||
rs2("BBetragGebunden_neu") = rs1("BBetragGebunden") * faktor
|
||||
rs2("BBetragUngebunden_neu") = rs1("BBetragUngebunden") * faktor
|
||||
rs2("Korrekturbetrag") = 0
|
||||
rs2.Update
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
rs2.Close
|
||||
|
||||
'3. runden für gleichen Betrag
|
||||
Set rs1 = db1.OpenRecordset("SELECT DISTINCT MGNR FROM TLieferungen WHERE MGNR>0 AND MGNR NOT IN (SELECT MGNR FROM TMitglieder WHERE Buchführend=True) AND datum>Datevalue('01.01.2015') order by MGNR")
|
||||
While Not rs1.EOF
|
||||
|
||||
summe1 = DSum("BTeilzahlung1", "xTempLieferungen", "MGNR=" + Format(rs1("MGNR")))
|
||||
summe2 = 0
|
||||
If summe1 <> 0 Then
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE MGNR=" + Format(rs1("MGNR")))
|
||||
|
||||
While Not rs2.EOF
|
||||
|
||||
rs2.Edit
|
||||
rs2("BTeilzahlung1_neu") = Runden(rs2("BTeilzahlung1_neu"), 2)
|
||||
If Not IsNull(rs2("BBetragGebunden_neu")) Then
|
||||
rs2("BBetragGebunden_neu") = Runden(rs2("BBetragGebunden_neu"), 3)
|
||||
End If
|
||||
If Not IsNull(rs2("BBetragUngebunden_neu")) Then
|
||||
rs2("BBetragUngebunden_neu") = Runden(rs2("BBetragUngebunden_neu"), 3)
|
||||
End If
|
||||
summe2 = summe2 + rs2("BTEilzahlung1_neu")
|
||||
rs2.Update
|
||||
rs2.MoveNext
|
||||
Wend
|
||||
rs2.MovePrevious
|
||||
'letzten Eintrag auf korrekte Summe korrigieren
|
||||
rs2.Edit
|
||||
'rs2("Korrekturbetrag") = (summe2 * 1.12 - summe1 * 1.13) / 1.12
|
||||
rs2("Korrekturbetrag") = Runden((Runden(summe2 * 1.12, 2) - Runden(summe1 * 1.13, 2)) / 1.12, 2)
|
||||
rs2("GesamtBrutto") = Runden(summe1 * 1.13, 2)
|
||||
rs2("GesamtBrutto_neu") = Runden(summe2 * 1.12, 2)
|
||||
rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2)
|
||||
|
||||
If rs2("GesamtBrutto_neu_korrigiert") > rs2("GesamtBrutto") Then
|
||||
rs2("Korrekturbetrag") = rs2("Korrekturbetrag") + 0.01
|
||||
rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2)
|
||||
End If
|
||||
If rs2("GesamtBrutto_neu_korrigiert") < rs2("GesamtBrutto") Then
|
||||
rs2("Korrekturbetrag") = rs2("Korrekturbetrag") - 0.01
|
||||
rs2("GesamtBrutto_neu_korrigiert") = Runden((summe2 - rs2("Korrekturbetrag")) * 1.12, 2)
|
||||
End If
|
||||
rs2.Update
|
||||
|
||||
rs2.Close
|
||||
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
'Exit Sub
|
||||
'4. Rückübertragung in TLieferungen
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM xTempLieferungen WHERE BTeilzahlung1>0 ORDER BY LINR")
|
||||
While Not rs1.EOF
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM TLieferungen where LINR=" + Format(rs1("LINR")))
|
||||
If Not rs2.EOF Then
|
||||
rs2.Edit
|
||||
rs2("BTeilzahlung1") = Runden(rs1("BTeilzahlung1_neu") - rs1("Korrekturbetrag"), 2)
|
||||
rs2("BBetragGebunden") = rs1("BBetragGebunden_neu")
|
||||
rs2("BBetragUngebunden") = rs1("BBetragUngebunden_neu")
|
||||
rs2.Update
|
||||
End If
|
||||
rs2.Close
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub Auszahlung2015_NettoPreiseProKg_anheben()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Dim faktor As Double
|
||||
|
||||
Set db1 = CurrentDb
|
||||
faktor = 1.13 / 1.12
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=140")
|
||||
While Not rs1.EOF
|
||||
rs1.Edit
|
||||
If Not IsNull(rs1("Betrag")) Then
|
||||
rs1("Betrag") = Runden(faktor * rs1("Betrag"), 3)
|
||||
End If
|
||||
rs1.Update
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSortenQualitätsstufe WHERE AZNR=140")
|
||||
While Not rs1.EOF
|
||||
rs1.Edit
|
||||
If Not IsNull(rs1("Betrag")) Then
|
||||
rs1("Betrag") = Runden(faktor * rs1("Betrag"), 3)
|
||||
End If
|
||||
rs1.Update
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,613 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Function GetActiveCharge(SNR1 As String, QSNR1 As Long, ZNR1 As Long, Optional ByVal SANR1 As Variant) As Long
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Suche nach Charge, die alle Kriterien erfüllt
|
||||
If Not IsNull(SANR1) And SANR1 <> "" Then
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TChargen WHERE SNR='" + SNR1 + "' AND SANR='" + SANR1 + "' AND (QSNRVon<=" + Format(QSNR1) + " OR ISNULL(QSNRVon)) AND (QSNRBis>=" + Format(QSNR1) + " OR IsNull(QSNRBis)) AND ZNR=" + Format(ZNR1) + " AND CSNR=2")
|
||||
Else
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TChargen WHERE SNR='" + SNR1 + "' AND (QSNRVon<=" + Format(QSNR1) + " OR ISNULL(QSNRVon)) AND (QSNRBis>=" + Format(QSNR1) + " OR IsNull(QSNRBis)) AND ZNR=" + Format(ZNR1) + " AND CSNR=2")
|
||||
End If
|
||||
If rs1.EOF Then
|
||||
GetActiveCharge = -1
|
||||
Else
|
||||
GetActiveCharge = rs1("CNR")
|
||||
End If
|
||||
rs1.Close
|
||||
|
||||
End Function
|
||||
|
||||
Public Function ChargeBefuellen(CNR1 As Long, LINR1 As Long) As Boolean
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsb As Recordset
|
||||
Dim verbuchen As Boolean
|
||||
|
||||
ChargeBefuellen = False
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
If rsc.EOF Then
|
||||
rsc.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsc("BNR")))
|
||||
If rsb.EOF Then
|
||||
rsb.Close
|
||||
MsgBox ("Behälter nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'2. Überprüfen, ob Charge im richtigen Status und Lieferung zugeordnet
|
||||
'TODO
|
||||
'Charge im Status 2?
|
||||
'Lieferung ist diese Charge zugeordnet?
|
||||
'Chargentyp=Maische?
|
||||
|
||||
|
||||
If rsl("AufChargeVerbucht") = True Then
|
||||
If MsgBox("Diese Lieferung wurde bereits verbucht! Sind Sie sicher, diese Lieferung nochmals zu verbuchen?", vbYesNo) = vbYes Then
|
||||
verbuchen = True
|
||||
Else
|
||||
verbuchen = False
|
||||
End If
|
||||
Else
|
||||
verbuchen = True
|
||||
End If
|
||||
|
||||
|
||||
'3. Aktualisierung Menge und Oechsle unter Berücksichtigung des Reduktionsfaktors
|
||||
If verbuchen = True Then
|
||||
|
||||
rsc.Edit
|
||||
If IsNull(rsc("Oechsle")) Or IsNull(rsc("Menge")) Then
|
||||
'erste lieferung
|
||||
rsc("Oechsle") = rsl("Oechsle")
|
||||
rsc("Menge") = rsl("Gewicht")
|
||||
Else
|
||||
rsc("Oechsle") = (rsc("Menge") * rsc("Oechsle") + rsl("Gewicht") * rsl("Oechsle")) / (rsc("Menge") + rsl("Gewicht"))
|
||||
rsc("Menge") = rsc("Menge") + rsl("Gewicht")
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'4. Überprüfung der Charge, ob voll wird
|
||||
'If rsc("Menge") > rsb("MaxMenge") And GetParameter("CHARGENWARNUNG_BEHAELTERVOLL") = "Ja" Then
|
||||
' If MsgBox("Der Behälter der ausgewählten Charge wird mit dieser Lieferung überfüllt! Wollen Sie die Befüllung trotzdem durchführen?", vbYesNo) = vbYes Then
|
||||
' rsc.update
|
||||
' Else
|
||||
' End If
|
||||
'Else
|
||||
rsc.Update
|
||||
|
||||
'5. Aktualisieren der Lieferung
|
||||
'rsl.Edit
|
||||
'rsl("AufChargeVerbucht") = True
|
||||
'rsl.Update
|
||||
ChargeBefuellen = True
|
||||
End If
|
||||
|
||||
|
||||
rsc.Close
|
||||
rsb.Close
|
||||
rsl.Close
|
||||
|
||||
End Function
|
||||
|
||||
Public Sub ChargeBefuellungRueckgaengig(CNR1 As Long, LINR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsb As Recordset
|
||||
Dim verbuchen As Boolean
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
If rsc.EOF Then
|
||||
rsc.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If rsl("AufChargeVerbucht") = False Then
|
||||
If MsgBox("Diese Lieferung wurde noch gar nicht verbucht! Sind Sie sicher, die Verbuchung rückgängig zu machen?", vbYesNo) = vbYes Then
|
||||
verbuchen = True
|
||||
Else
|
||||
verbuchen = False
|
||||
End If
|
||||
Else
|
||||
verbuchen = True
|
||||
End If
|
||||
|
||||
If verbuchen = True Then
|
||||
'2. Aktualisierung Menge und Oechsle unter Berücksichtigung des Reduktionsfaktors
|
||||
rsc.Edit
|
||||
If rsc("Oechsle") > 0 And rsc("Menge") > rsl("Gewicht") Then
|
||||
rsc("Oechsle") = (rsc("Oechsle") * rsc("Menge") - rsl("Gewicht") * rsl("Oechsle")) / (rsc("Menge") - rsl("Gewicht"))
|
||||
rsc("Menge") = rsc("Menge") - rsl("Gewicht")
|
||||
End If
|
||||
rsc.Update
|
||||
|
||||
'3. Verbuchung Kennzeichnung aufheben
|
||||
rsl.Edit
|
||||
rsl("AufChargeVerbucht") = False
|
||||
rsl.Update
|
||||
End If
|
||||
|
||||
|
||||
rsc.Close
|
||||
rsl.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function NeueCharge(Optional Lesejahr As Long) As Long
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim CNR1 As Long
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen")
|
||||
|
||||
'If rsc.recordcount = 0 Then
|
||||
' CNR1 = 1
|
||||
'Else
|
||||
' CNR1 = DMax("CNR", "TChargen") + 1
|
||||
'End If
|
||||
|
||||
rsc.AddNew
|
||||
'rsc("CNR") = CNR1
|
||||
NeueCharge = rsc("CNR")
|
||||
rsc("Menge") = 0
|
||||
rsc("ZNR") = GetParameter("LETZTEZNR")
|
||||
If Lesejahr > 0 Then
|
||||
rsc("Jahrgang") = Lesejahr
|
||||
End If
|
||||
rsc("CSNR") = 1
|
||||
rsc("Art") = "Maische"
|
||||
rsc.Update
|
||||
rsc.Close
|
||||
|
||||
End Function
|
||||
|
||||
Function ChargeClonen(CNR1 As Long, BNR1 As Long, Optional Menge1 As Long, Optional Oechsle1 As Long) As Long
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsc2 As Recordset
|
||||
Dim i
|
||||
Dim Maxcounter1 As Long
|
||||
Set db1 = CurrentDb
|
||||
Dim CNR2 As Long
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen where CNR=" + Format(CNR1))
|
||||
Set rsc2 = db1.OpenRecordset("SELECT * FROM TChargen")
|
||||
|
||||
If Not rsc.EOF Then
|
||||
rsc2.AddNew
|
||||
For i = 0 To rsc2.Fields.Count - 1
|
||||
If rsc2.Fields(i).Name <> "Chargennummer" And rsc2.Fields(i).Name <> "CNR" And rsc2.Fields(i).Name <> "BNR" Then
|
||||
rsc2.Fields(i) = rsc.Fields(i)
|
||||
End If
|
||||
Next i
|
||||
'CNR2 = DMax("CNR", "TChargen") + 1
|
||||
'rsc2("CNR") = CNR2
|
||||
ChargeClonen = rsc2("CNR")
|
||||
CNR2 = rsc2("CNR")
|
||||
rsc2("BNR") = BNR1
|
||||
If Not IsNull(Menge1) Then
|
||||
rsc2("Menge") = Menge1
|
||||
End If
|
||||
If Not IsNull(Oechsle1) Then
|
||||
rsc2("Oechsle") = Oechsle1
|
||||
End If
|
||||
rsc2("CSNR") = 2
|
||||
rsc2.Update
|
||||
rsc2.Close
|
||||
Set rsc2 = db1.OpenRecordset("SELECT * FROM TChargen where CNR=" + Format(CNR2))
|
||||
rsc2.Edit
|
||||
rsc2("Chargennummer") = GeneriereChargennummer(rsc2("CNR"), Maxcounter1)
|
||||
rsc2("ChargennummerZaehler") = Maxcounter1
|
||||
rsc2.Update
|
||||
End If
|
||||
rsc.Close
|
||||
rsc2.Close
|
||||
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function GeneriereChargennummer(CNR1 As Long, Optional Maxcounter1 As Long) As String
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim Chargennummer As String
|
||||
Dim Maxcounter As Long
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
|
||||
Select Case GetParameter("CHARGENNUMMERTYP")
|
||||
|
||||
Case "1": 'BehälterKurzbezeichnung + Zähler (pro Behälter)+ DatumBefüllung
|
||||
|
||||
If rsc("BNR") > 0 And rsc("Jahrgang") > 0 Then
|
||||
If IsNull(DMax("ChargennummerZaehler", "TChargen", "BNR=" + Format(rsc("BNR")) + " AND Jahrgang=" + Format(rsc("Jahrgang")))) Then
|
||||
Maxcounter = 0
|
||||
Else
|
||||
Maxcounter = DMax("ChargennummerZaehler", "TChargen", "BNR=" + Format(rsc("BNR")) + " AND Jahrgang=" + Format(rsc("Jahrgang")))
|
||||
End If
|
||||
Chargennummer = DFirst("Kurzbezeichnung", "TBehaelter", "BNR=" + Format(rsc("BNR"))) + "-" + Format(Maxcounter + 1, "0000") + "-" + Format(year(Date), "0000") + Format(Month(Date), "00") + Format(Day(Date), "00")
|
||||
Maxcounter1 = Maxcounter + 1
|
||||
End If
|
||||
|
||||
Case "2":
|
||||
|
||||
|
||||
Case "3":
|
||||
|
||||
|
||||
End Select
|
||||
|
||||
rsc.Close
|
||||
GeneriereChargennummer = Chargennummer
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub ChargeBefuellungStarten(CNR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
|
||||
If Not rsc.EOF Then
|
||||
|
||||
'div. Abfragen
|
||||
If rsc("CSNR") <> 1 Then
|
||||
MsgBox "Die Befüllung kann nur aus dem Zustand 'Erstellt' aus starten!", vbCritical
|
||||
rsc.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If IsNull(rsc("BNR")) Then
|
||||
MsgBox "Bitte zuerst einen Behälter zuweisen!", vbCritical
|
||||
rsc.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
rsc.Edit
|
||||
rsc("CSNR") = 2
|
||||
rsc("Befuellungsbeginn") = Date
|
||||
rsc.Update
|
||||
|
||||
End If
|
||||
rsc.Close
|
||||
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ChargeBefuellungBeenden(CNR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
|
||||
If Not rsc.EOF Then
|
||||
|
||||
'div. Abfragen
|
||||
If rsc("CSNR") <> 2 Then
|
||||
MsgBox "Die Befüllung kann nur aus dem Zustand 'Befüllung' aus beendet werden!", vbCritical
|
||||
rsc.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
rsc.Edit
|
||||
rsc("CSNR") = 3
|
||||
rsc("Befuellungsende") = Date
|
||||
rsc.Update
|
||||
|
||||
End If
|
||||
rsc.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChargenErstellenAusPlanung(date1 As Date)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsp As Recordset
|
||||
Dim rsc As Recordset
|
||||
Dim CNR1 As Long
|
||||
Dim CSNR1 As Long
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rsp = db1.OpenRecordset("SELECT * FROM TLeseplanung WHERE Datum=DateValue('" + Format(date1) + "') ORDER BY SNR")
|
||||
If rsp.EOF Then
|
||||
MsgBox "Keine Planung für diesen Tag gefunden!", vbCritical
|
||||
rsp.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If MsgBox("Wollen Sie die Chargen gleich zur Befüllung freigeben?", vbYesNo) = vbYes Then
|
||||
CSNR1 = 2
|
||||
Else
|
||||
CSNR1 = 1
|
||||
End If
|
||||
|
||||
While Not rsp.EOF
|
||||
|
||||
CNR1 = NeueCharge(year(rsp("Datum")))
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNR1))
|
||||
rsc.Edit
|
||||
rsc("SNR") = rsp("SNR")
|
||||
If Not IsNull(rsp("SANR")) Then
|
||||
rsc("SANR") = rsp("SANR")
|
||||
End If
|
||||
rsc("Befuellungsbeginn") = rsp("Datum")
|
||||
rsc("Jahrgang") = year(rsp("Datum"))
|
||||
If Not IsNull(rsp("QSNRVon")) Then
|
||||
rsc("QSNRVon") = rsp("QSNRVon")
|
||||
End If
|
||||
If Not IsNull(rsp("QSNRBis")) Then
|
||||
rsc("QSNRBis") = rsp("QSNRBis")
|
||||
End If
|
||||
rsc("CSNR") = CSNR1
|
||||
|
||||
rsc.Update
|
||||
rsc.Close
|
||||
rsp.MoveNext
|
||||
Wend
|
||||
rsp.Close
|
||||
MsgBox ("Bitte den Chargen noch Behälter zuordnen")
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChargeUmfuellen(CNRVon As Long, CNRNach As Long, Menge As Double, Optional MengeZuruecksetzen As Boolean, Optional OechsleZuruecksetzen As Boolean, Optional StatusEntleert As Boolean)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsvon As Recordset
|
||||
Dim rsnach As Recordset
|
||||
Dim rsh As Recordset
|
||||
Dim rsb As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rsvon = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRVon))
|
||||
Set rsnach = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRNach))
|
||||
Set rsh = db1.OpenRecordset("SELECT * FROM TChargenHierarchie WHERE CNR_Parent=" + Format(CNRVon) + " AND CNR_Child=" + Format(CNRNach))
|
||||
Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsnach("BNR")))
|
||||
|
||||
'Anwendung des Reduktionsfaktors
|
||||
Menge = Menge * rsb("Reduktionsfaktor")
|
||||
|
||||
'Überprüfe Überschreitung des Füllstandes der Zielcharge
|
||||
If rsb("MaxMenge") < rsnach("Menge") + Menge Then
|
||||
If MsgBox("Die angegebene Menge würde die maximal mögliche Füllmenge des Behälters überschreiten. Maximal sind " + Format(rsb("MaxMenge") - rsnach("Menge")) + " möglich. Wollen Sie trotzdem die Umfüllung vornehmen?", vbYesNo) = vbNo Then
|
||||
rsvon.Close
|
||||
rsnach.Close
|
||||
rsh.Close
|
||||
rsb.Close
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
'Update Hierarchie
|
||||
If rsh.EOF Then
|
||||
rsh.AddNew
|
||||
rsh("CNR_Parent") = CNRVon
|
||||
rsh("CNR_Child") = CNRNach
|
||||
Else
|
||||
rsh.Edit
|
||||
End If
|
||||
|
||||
If IsNull(rsh("Menge")) Then
|
||||
rsh("Menge") = Menge
|
||||
Else
|
||||
rsh("Menge") = rsh("Menge") + Menge
|
||||
End If
|
||||
rsh.Update
|
||||
|
||||
'Update Zielcharge
|
||||
rsnach.Edit
|
||||
If IsNull(rsnach("Menge")) Then
|
||||
rsnach("Menge") = 0
|
||||
End If
|
||||
If IsNull(rsnach("Oechsle")) Then
|
||||
rsnach("Oechsle") = 0
|
||||
End If
|
||||
|
||||
|
||||
|
||||
rsnach("Oechsle") = (rsnach("Menge") * rsnach("Oechsle") + Menge * rsvon("Oechsle") * rsb("Reduktionsfaktor")) / (rsnach("Menge") + Menge * rsb("Reduktionsfaktor"))
|
||||
rsnach("Menge") = rsnach("Menge") + Menge * rsb("Reduktionsfaktor")
|
||||
rsnach.Update
|
||||
|
||||
'Update Ursprungscharge
|
||||
rsvon.Edit
|
||||
If StatusEntleert And rsvon("Menge") <= 0 Then
|
||||
rsvon("CSNR") = 4
|
||||
End If
|
||||
If MengeZuruecksetzen Then
|
||||
rsvon("Menge") = rsvon("Menge") - Menge
|
||||
End If
|
||||
If OechsleZuruecksetzen Then
|
||||
rsvon("Oechsle") = Null
|
||||
End If
|
||||
rsvon.Update
|
||||
|
||||
rsvon.Close
|
||||
rsnach.Close
|
||||
rsh.Close
|
||||
rsb.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Function ChargeStandNachFuellung(LINR1 As Long) As Double
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsb As Recordset
|
||||
Dim ueberfuellt As Double
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
'MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(rsl("CNR")))
|
||||
If rsc.EOF Then
|
||||
rsc.Close
|
||||
'MsgBox ("Charge nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set rsb = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BNR=" + Format(rsc("BNR")))
|
||||
If rsb.EOF Then
|
||||
rsb.Close
|
||||
'MsgBox ("Behälter nicht gefunden!")
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'2. Überprüfen, ob Charge im richtigen Status und Lieferung zugeordnet
|
||||
'TODO
|
||||
'Charge im Status 2?
|
||||
'Lieferung ist diese Charge zugeordnet?
|
||||
'Chargentyp=Maische?
|
||||
|
||||
If IsNull(rsc("Menge")) Then
|
||||
ueberfuellt = rsl("Gewicht") - rsb("MaxMenge")
|
||||
Else
|
||||
ueberfuellt = rsc("Menge") + rsl("Gewicht") - rsb("MaxMenge")
|
||||
End If
|
||||
ChargeStandNachFuellung = ueberfuellt
|
||||
|
||||
rsc.Close
|
||||
rsb.Close
|
||||
rsl.Close
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub ChargenZuLieferungenZuordnen(Lesejahr1 As Long, Optional ZNR1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim where1 As String
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
If ZNR1 > 0 Then
|
||||
where1 = " WHERE Year(Datum)=" + Format(Lesejahr1) + " AND ZNR=" + Format(ZNR1)
|
||||
Else
|
||||
where1 = " WHERE Year(Datum)=" + Format(Lesejahr1)
|
||||
End If
|
||||
where1 = where1 + " AND NOT SNR=Null and not QSNR=Null and not Datum=Null "
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen " + where1)
|
||||
While Not rsl.EOF
|
||||
where1 = " WHERE SNR='" + Format(rsl("SNR")) + "' AND Befuellungsbeginn=DateValue('" + Format(rsl("Datum"), "dd.mm.yyyy") + "') "
|
||||
where1 = where1 + " AND (QSNRVon<=" + Format(rsl("QSNR")) + " OR QSNRVon=Null) AND (QSNRBis>=" + Format(rsl("QSNR")) + " OR QSNRBis=Null)"
|
||||
Set rsc = db1.OpenRecordset("SELECT * FROM TChargen " + where1)
|
||||
If IsNull(rsl("CNR")) Then
|
||||
If Not rsc.EOF Then
|
||||
rsl.Edit
|
||||
rsl("CNR") = rsc("CNR")
|
||||
rsl("AufChargeVerbucht") = True
|
||||
rsl.Update
|
||||
End If
|
||||
End If
|
||||
rsl.MoveNext
|
||||
Wend
|
||||
|
||||
db1.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChargenLieferungenZuordnungÄndern(LINR1 As Long, CNRVon As Long, CNRNach As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rsc_von As Recordset
|
||||
Dim rsl As Recordset
|
||||
Dim rsc_nach As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'1. Öffnen der Datensätze
|
||||
Set rsc_von = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRVon))
|
||||
If rsc_von.EOF Then
|
||||
rsc_von.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set rsc_nach = db1.OpenRecordset("SELECT * FROM TChargen WHERE CNR=" + Format(CNRNach))
|
||||
If rsc_nach.EOF Then
|
||||
rsc_nach.Close
|
||||
MsgBox ("Charge nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set rsl = db1.OpenRecordset("SELECT * FROM TLieferungen WHERE LINR=" + Format(LINR1))
|
||||
If rsl.EOF Then
|
||||
rsl.Close
|
||||
MsgBox ("Lieferung nicht gefunden!")
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
ChargeBefuellungRueckgaengig CNRVon, LINR1
|
||||
ChargeBefuellen CNRNach, LINR1
|
||||
|
||||
|
||||
End Sub
|
||||
@ -1,89 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
Sub FlaechenbindungenBerechnen(Jahr1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
Dim temptablename1 As String
|
||||
Dim oldMGNR As Long
|
||||
Dim countit As Boolean
|
||||
Dim summe As Double
|
||||
temptablename1 = "xTempFlaechenbindungen"
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set db1 = CurrentDb
|
||||
If TableExists(temptablename1) Then
|
||||
db1.Execute ("DROP TABLE " + temptablename1)
|
||||
End If
|
||||
db1.Execute ("CREATE TABLE " + temptablename1 + " (MGNR LONG, Gesamtflaeche DOUBLE);")
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen ORDER BY MGNR")
|
||||
Set rs2 = db1.OpenRecordset(temptablename1)
|
||||
oldMGNR = -1
|
||||
While Not rs1.EOF
|
||||
If oldMGNR <> rs1("MGNR") Then
|
||||
If oldMGNR <> -1 Then
|
||||
rs2("MGNR") = oldMGNR
|
||||
rs2("Gesamtflaeche") = summe
|
||||
rs2.Update
|
||||
End If
|
||||
rs2.AddNew
|
||||
summe = 0
|
||||
End If
|
||||
|
||||
countit = True
|
||||
If IsNull(rs1("Von")) Then
|
||||
Else
|
||||
If rs1("Von") <= Jahr1 Then
|
||||
Else
|
||||
countit = False
|
||||
End If
|
||||
End If
|
||||
|
||||
If IsNull(rs1("Bis")) Then
|
||||
Else
|
||||
If rs1("Bis") >= Jahr1 Then
|
||||
Else
|
||||
countit = False
|
||||
End If
|
||||
End If
|
||||
|
||||
If IsNull(rs1("Flaeche")) Then
|
||||
countit = False
|
||||
End If
|
||||
|
||||
If countit Then
|
||||
summe = summe + rs1("Flaeche")
|
||||
End If
|
||||
oldMGNR = rs1("MGNR")
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs2.Update
|
||||
rs1.Close
|
||||
rs2.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function TableExists(table1) As Boolean
|
||||
|
||||
Dim db1 As Database
|
||||
Set db1 = CurrentDb
|
||||
Dim x As TableDef
|
||||
|
||||
For Each x In db1.TableDefs
|
||||
If x.Name = table1 Then
|
||||
TableExists = True
|
||||
Exit Function
|
||||
End If
|
||||
Next x
|
||||
|
||||
TableExists = False
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
@ -1,45 +0,0 @@
|
||||
Option Compare Database
|
||||
|
||||
|
||||
|
||||
Sub bankdaten_migration()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
Dim MGNR As Long
|
||||
Dim KontoNr As String
|
||||
Dim BLZ As String
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("TMitglieder")
|
||||
|
||||
db1.Execute ("UPDATE RTRN6730000000000001 Set Übernommen=False")
|
||||
While Not rs1.EOF
|
||||
MGNR = rs1("MGNR")
|
||||
If Not IsNull(rs1("KontoNr")) And Not IsNull(rs1("BLZ")) Then
|
||||
KontoNr = rs1("Kontonr")
|
||||
KontoNr = Replace(KontoNr, ".", "")
|
||||
KontoNr = Replace(KontoNr, "-", "")
|
||||
KontoNr = Replace(KontoNr, " ", "")
|
||||
BLZ = rs1("BLZ")
|
||||
While Left(KontoNr, 1) = "0"
|
||||
KontoNr = Mid(KontoNr, 2)
|
||||
Wend
|
||||
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM RTRN6730000000000001 WHERE BLZ='" + BLZ + "' AND KontoNummer='" + KontoNr + "'")
|
||||
If Not rs2.EOF Then
|
||||
rs1.Edit
|
||||
rs1("IBAN") = rs2("IBAN")
|
||||
rs1("BIC") = rs2("BIC")
|
||||
rs1.Update
|
||||
rs2.Edit
|
||||
rs2("Übernommen") = True
|
||||
rs2.Update
|
||||
End If
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
|
||||
End Sub
|
||||
@ -1,501 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
Sub test()
|
||||
|
||||
SwitchToolbars (True)
|
||||
|
||||
End Sub
|
||||
|
||||
Function SwitchToolbars(onoff As Boolean)
|
||||
|
||||
'For Runtime
|
||||
Exit Function
|
||||
|
||||
If (onoff) Then
|
||||
|
||||
DoCmd.ShowToolbar "Menüleiste", acToolbarYes '
|
||||
DoCmd.ShowToolbar "Formularansicht", acToolbarYes
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
DoCmd.SetDisplayedCategories (True)
|
||||
'ÄndernEigenschaft "StartupForm", dbText, "MHauptmenü"
|
||||
ÄndernEigenschaft "StartupShowDBWindow", dbBoolean, True
|
||||
ÄndernEigenschaft "StartupShowStatusBar", dbBoolean, True
|
||||
ÄndernEigenschaft "AllowFullMenus", dbBoolean, True
|
||||
|
||||
Else
|
||||
|
||||
DoCmd.ShowToolbar "Menüleiste", acToolbarNo
|
||||
DoCmd.ShowToolbar "Formularansicht", acToolbarNo
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
DoCmd.SetDisplayedCategories (False)
|
||||
'ÄndernEigenschaft "StartupForm", dbText, "MHauptmenü"
|
||||
ÄndernEigenschaft "StartupShowDBWindow", dbBoolean, False
|
||||
ÄndernEigenschaft "StartupShowStatusBar", dbBoolean, False
|
||||
ÄndernEigenschaft "AllowFullMenus", dbBoolean, False
|
||||
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function StartupValues()
|
||||
|
||||
'ÄndernEigenschaft "StartupShowDBWindow", dbBoolean, False
|
||||
'ÄndernEigenschaft "StartupShowStatusBar", dbBoolean, False
|
||||
|
||||
End Function
|
||||
|
||||
Function ÄndernEigenschaft(strEigenschaftenname As String, varEigenschaftentyp As Variant, varEigenschaftenwert As Variant) As Integer
|
||||
Dim dbs As Database, prp As property
|
||||
Const conPropNotFoundError = 3270
|
||||
|
||||
Set dbs = CurrentDb
|
||||
On Error GoTo Ändern_Fehler
|
||||
dbs.Properties(strEigenschaftenname) = varEigenschaftenwert
|
||||
ÄndernEigenschaft = True
|
||||
|
||||
Ändern_Ende:
|
||||
Exit Function
|
||||
|
||||
Ändern_Fehler:
|
||||
|
||||
If Err = conPropNotFoundError Then ' Eigenschaft nicht gefunden.
|
||||
Set prp = dbs.CreateProperty(strEigenschaftenname, _
|
||||
varEigenschaftentyp, varEigenschaftenwert)
|
||||
dbs.Properties.Append prp
|
||||
Resume Next
|
||||
Else
|
||||
' Unbekannter Fehler.
|
||||
ÄndernEigenschaft = False
|
||||
Resume Ändern_Ende
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function GetLocalParameter(Name1 As String) As Variant
|
||||
|
||||
GetLocalParameter = DFirst("[Wert]", "lParameter", "[Bezeichnung]='" + UCase(Name1) + "'")
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function GetParameter(Name1 As String) As Variant
|
||||
|
||||
GetParameter = DFirst("[Wert]", "TParameter", "[Bezeichnung]='" + UCase(Name1) + "'")
|
||||
|
||||
End Function
|
||||
|
||||
Sub SetParameter(Name1 As String, value1 As String)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim found As Boolean
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM TParameter;")
|
||||
|
||||
found = False
|
||||
rs1.MoveFirst
|
||||
While (Not rs1.EOF)
|
||||
If (UCase(rs1!Bezeichnung) = UCase(Name1)) Then found = True
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM TParameter;")
|
||||
|
||||
If found = True Then
|
||||
rs1.MoveFirst
|
||||
While (UCase(rs1!Bezeichnung) <> UCase(Name1))
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Edit
|
||||
rs1!Wert = value1
|
||||
rs1.Update
|
||||
Else:
|
||||
rs1.AddNew
|
||||
rs1!Bezeichnung = Name1
|
||||
rs1!Wert = value1
|
||||
rs1.Update
|
||||
End If
|
||||
|
||||
rs1.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetLocalParameter(Name1 As String, value1 As String)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim found As Boolean
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM lParameter;")
|
||||
|
||||
found = False
|
||||
rs1.MoveFirst
|
||||
While (Not rs1.EOF)
|
||||
If (UCase(rs1!Bezeichnung) = UCase(Name1)) Then found = True
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Wert FROM lParameter;")
|
||||
|
||||
If found = True Then
|
||||
rs1.MoveFirst
|
||||
While (UCase(rs1!Bezeichnung) <> UCase(Name1))
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Edit
|
||||
rs1!Wert = value1
|
||||
rs1.Update
|
||||
Else:
|
||||
rs1.AddNew
|
||||
rs1!Bezeichnung = Name1
|
||||
rs1!Wert = value1
|
||||
rs1.Update
|
||||
End If
|
||||
|
||||
rs1.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
Function Qualitätsstufe(Oechsle) As Variant
|
||||
|
||||
If IsNull(Oechsle) Then
|
||||
Qualitätsstufe = Null
|
||||
Else
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Qualitätsstufe = ""
|
||||
Set rs1 = db1.OpenRecordset("SELECT Bezeichnung,Von,Bis FROM TQualitaetsstufen;")
|
||||
|
||||
rs1.MoveFirst
|
||||
|
||||
While Not rs1.EOF
|
||||
If Oechsle >= rs1!Von And Oechsle <= rs1!Bis Then
|
||||
Qualitätsstufe = rs1!Bezeichnung
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function QSNR(Oechsle As Long) As Long
|
||||
|
||||
If IsNull(Oechsle) Then
|
||||
QSNR = Null
|
||||
Else
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
QSNR = Null
|
||||
Set rs1 = db1.OpenRecordset("SELECT QSNR,Von,Bis FROM TQualitaetsstufen;")
|
||||
|
||||
rs1.MoveFirst
|
||||
|
||||
While Not rs1.EOF
|
||||
If Oechsle >= rs1!Von And Oechsle <= rs1!Bis Then
|
||||
QSNR = rs1!QSNR
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function Fileexist(filename As String) As Boolean
|
||||
|
||||
On Error GoTo NoFile
|
||||
|
||||
If FileSystem.GetAttr(filename) >= 0 Then
|
||||
Fileexist = True
|
||||
Else
|
||||
Fileexist = False
|
||||
End If
|
||||
|
||||
Exit Function
|
||||
|
||||
NoFile:
|
||||
Fileexist = False
|
||||
Exit Function
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function GetAppPath() As String
|
||||
|
||||
Dim db1 As Database
|
||||
Set db1 = CurrentDb
|
||||
|
||||
'GetAppPath = Mid(db1.Name, 1, Len(db1.Name) - Len("WGMASTER.ACCDB"))
|
||||
GetAppPath = Mid(db1.Name, 1, Len(db1.Name) - Len("WGMASTER2010.ACCDB"))
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Function GetDataPath() As String
|
||||
|
||||
Dim datapath As String
|
||||
datapath = DFirst("Data", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten))
|
||||
GetDataPath = datapath
|
||||
|
||||
End Function
|
||||
|
||||
Function GetPathWithoutFilename(fullpath As String) As String
|
||||
|
||||
Dim str1 As String
|
||||
|
||||
str1 = fullpath
|
||||
|
||||
While Len(str1) > 0 And Mid(str1, Len(str1), 1) <> "\"
|
||||
str1 = Mid(str1, 1, Len(str1) - 1)
|
||||
If str1 = "" Then
|
||||
GetPathWithoutFilename = ""
|
||||
Exit Function
|
||||
End If
|
||||
Wend
|
||||
|
||||
GetPathWithoutFilename = str1
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Function GetLastMANR() As Long
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim found As Boolean
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM Mandanten;")
|
||||
|
||||
GetLastMANR = -1
|
||||
While (Not rs1.EOF)
|
||||
If rs1!Last = True Then
|
||||
GetLastMANR = rs1!MANR
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub SetLastMANR(manr1 As Long)
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim found As Boolean
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM Mandanten;")
|
||||
|
||||
found = False
|
||||
While (Not rs1.EOF)
|
||||
|
||||
If rs1!Last = True Then
|
||||
rs1.Edit
|
||||
rs1!Last = False
|
||||
rs1.Update
|
||||
End If
|
||||
If rs1!MANR = manr1 Then
|
||||
rs1.Edit
|
||||
rs1!Last = True
|
||||
rs1.Update
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Public Function Runden(value1 As Double, digits As Integer) As Double
|
||||
|
||||
Dim temp1 As Double
|
||||
|
||||
temp1 = value1 * (10 ^ digits)
|
||||
|
||||
If (temp1 * 10) Mod 10 = 5 Then
|
||||
temp1 = temp1 + 1
|
||||
temp1 = Fix(temp1)
|
||||
temp1 = temp1 / (10 ^ digits)
|
||||
Runden = temp1
|
||||
Else
|
||||
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Public Function GetAbschlägeAsString(LINR1 As Long) As String
|
||||
Const separator = " / "
|
||||
Const separator_length = 3
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim resultString As String
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT TAbschlaege.* FROM (TLieferungAbschlag INNER JOIN TAbschlaege ON TLieferungAbschlag.ASNR = TAbschlaege.ASNR) INNER JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE TLieferungen.LINR=" + Format(LINR1))
|
||||
|
||||
resultString = ""
|
||||
While Not rs1.EOF
|
||||
resultString = resultString + separator + rs1!Bezeichnung
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
If resultString <> "" Then resultString = Mid(resultString, 1 + separator_length)
|
||||
|
||||
GetAbschlägeAsString = resultString
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Public Function GetSNRAndSANRFromInput(SNRInput As String, SNR As String, SANR As String) As Boolean
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TSortenAttributeEingabe WHERE SNREingabe='" + SNRInput + "'")
|
||||
If Not rs1.EOF Then
|
||||
SNR = rs1("SNR")
|
||||
SANR = rs1("SANR")
|
||||
GetSNRAndSANRFromInput = True
|
||||
Else
|
||||
GetSNRAndSANRFromInput = False
|
||||
End If
|
||||
rs1.Close
|
||||
|
||||
End Function
|
||||
|
||||
Public Function GetGebietGLNR(SNR As String, QSNR As Long, GLNR As Long) As Long
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR + "' AND MinQSNR<=" + Format(QSNR) + " AND GLNR=" + Format(GLNR))
|
||||
If rs1.EOF Then
|
||||
rs1.Close
|
||||
'Standardgebiet nehmen
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR))
|
||||
End If
|
||||
GetGebietGLNR = rs1("WBGNR")
|
||||
rs1.Close
|
||||
|
||||
End Function
|
||||
|
||||
Public Function GetGebiet(SNR As String, QSNR As Long, GLNR As Long) As String
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR + "' AND MinQSNR<=" + Format(QSNR) + " AND GLNR=" + Format(GLNR))
|
||||
If rs1.EOF Then
|
||||
rs1.Close
|
||||
'Standardgebiet nehmen
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR))
|
||||
End If
|
||||
GetGebiet = DFirst("Bezeichnung", "TGebiete", "WBGNR=" + Format(rs1("WBGNR")))
|
||||
rs1.Close
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Public Function GetHerkunft(SNR1 As String, QSNR1 As Long, GNR1 As Long) As String
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim WBGNR1 As Long
|
||||
Dim RGNR1 As Long
|
||||
Dim GLNR1 As Long
|
||||
|
||||
GLNR1 = DFirst("GLNR", "TGemeinden", "GNR=" + Format(GNR1))
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR1 + "' AND MinQSNR<=" + Format(QSNR1) + " AND GLNR=" + Format(GLNR1))
|
||||
If Not rs1.EOF Then
|
||||
'Spezialeintrag für diese Sorte und Qualität existiert
|
||||
WBGNR1 = rs1("WBGNR")
|
||||
Else
|
||||
rs1.Close
|
||||
'Standardgebiet nehmen
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR1))
|
||||
WBGNR1 = rs1("WBGNR")
|
||||
End If
|
||||
rs1.Close
|
||||
RGNR1 = DFirst("RGNR", "TGebiete", "WBGNR=" + Format(WBGNR1))
|
||||
|
||||
If Not IsNull(DFirst("Herkunftsbezeichnung", "TQualitaetsstufen", "QSNR=" + Format(QSNR1))) Then
|
||||
Select Case DFirst("Herkunftsbezeichnung", "TQualitaetsstufen", "QSNR=" + Format(QSNR1))
|
||||
Case "Land": GetHerkunft = "Österreich"
|
||||
Case "Region": GetHerkunft = DFirst("Bezeichnung", "TRegionen", "RGNR=" + Format(RGNR1))
|
||||
Case "Gebiet": GetHerkunft = DFirst("Bezeichnung", "TGebiete", "WBGNR=" + Format(WBGNR1))
|
||||
Case "Grosslage": GetHerkunft = DFirst("Bezeichnung", "TGrosslagen", "GLNR=" + Format(GLNR1))
|
||||
Case "Gemeinde": GetHerkunft = DFirst("Bezeichnung", "TGemeinden", "GNR=" + Format(GNR1))
|
||||
End Select
|
||||
Else
|
||||
GetHerkunft = DFirst("Bezeichnung", "TRegionen", "RGNR=" + Format(RGNR1))
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
Public Function GetHerkunftBKI(SNR1 As String, QSNR1 As Long, GNR1 As Long) As String
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim WBGNR1 As Long
|
||||
Dim RGNR1 As Long
|
||||
Dim GLNR1 As Long
|
||||
|
||||
GLNR1 = DFirst("GLNR", "TGemeinden", "GNR=" + Format(GNR1))
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslageGebietSorte WHERE SNR='" + SNR1 + "' AND MinQSNR<=" + Format(QSNR1) + " AND GLNR=" + Format(GLNR1))
|
||||
If Not rs1.EOF Then
|
||||
'Spezialeintrag für diese Sorte und Qualität existiert
|
||||
WBGNR1 = rs1("WBGNR")
|
||||
Else
|
||||
rs1.Close
|
||||
'Standardgebiet nehmen
|
||||
Set rs1 = db1.OpenRecordset("SELECT WBGNR FROM TGrosslagen WHERE GLNR=" + Format(GLNR1))
|
||||
WBGNR1 = rs1("WBGNR")
|
||||
End If
|
||||
rs1.Close
|
||||
RGNR1 = DFirst("RGNR", "TGebiete", "WBGNR=" + Format(WBGNR1))
|
||||
|
||||
If QSNR1 < 3 Then
|
||||
GetHerkunftBKI = DFirst("Herkunftsbezeichnung", "TQualitaetsstufen", "QSNR=" + Format(QSNR1))
|
||||
Else
|
||||
GetHerkunftBKI = DFirst("BKIKuerzel", "TGebiete", "WBGNR=" + Format(WBGNR1))
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,398 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Function SetDataPath()
|
||||
|
||||
'SetLinkTablePath "", GetParameter("DATAPATH") + "WGDATEN.ACCDB"
|
||||
'SetLinkTablePath "", "D:\PROJEKT\CHRIS\WGMASTER\WGDATEN.ACCDB"
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function SetFormProperty(FormName As String, PropertyName As String, PropertyValue As Variant)
|
||||
'Set Form Property, if Formname="" then set Property of all Forms
|
||||
|
||||
If FormName = "" Or IsNull(FormName) Then
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
Set db1 = CurrentDb
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Forms" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
DoCmd.OpenForm doc1.Name, acDesign
|
||||
On Error Resume Next
|
||||
Forms(doc1.Name).Properties(PropertyName) = PropertyValue
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
Next doc1
|
||||
End If
|
||||
Next cnt1
|
||||
|
||||
Else
|
||||
DoCmd.OpenForm FormName, acDesign
|
||||
Forms(FormName).Properties(PropertyName) = PropertyValue
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function GetFormProperty(FormName As String, PropertyName As String) As Variant
|
||||
'Read Form Property
|
||||
|
||||
DoCmd.OpenForm FormName, acDesign
|
||||
GetFormProperty = Forms(FormName).Properties(PropertyName)
|
||||
DoCmd.Close
|
||||
|
||||
End Function
|
||||
|
||||
Function SetFormControlProperty(FormName As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant)
|
||||
' Sets the given property of the given control in the given form to the given value
|
||||
' If Formname="" then all forms
|
||||
' If Controlname="" then all controls
|
||||
|
||||
Dim sec1 As Section
|
||||
Dim ctl1 As Control
|
||||
Dim i As Integer
|
||||
|
||||
If FormName = "" Or IsNull(FormName) Then
|
||||
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
Set db1 = CurrentDb
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Forms" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
DoCmd.OpenForm doc1.Name, acDesign
|
||||
'Search all Sections for desired Control
|
||||
For i = 0 To 4
|
||||
On Error Resume Next
|
||||
Set sec1 = Forms(doc1.Name).Section(i)
|
||||
For Each ctl1 In sec1.Controls
|
||||
If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
|
||||
'Has the desired control this property ?
|
||||
If Controltype = ctl1.Controltype Or Controltype = -1 Then
|
||||
On Error Resume Next
|
||||
ctl1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
End If
|
||||
Next ctl1
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
Next doc1
|
||||
End If
|
||||
Next cnt1
|
||||
|
||||
Else
|
||||
DoCmd.OpenForm FormName, acDesign
|
||||
For i = 0 To 4
|
||||
Set sec1 = Forms(FormName).Section(i)
|
||||
For Each ctl1 In sec1.Controls
|
||||
If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
|
||||
On Error Resume Next
|
||||
ctl1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
Next ctl1
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function SetFormSectionProperty(FormName As String, SectionName As String, PropertyName As String, PropertyValue As Variant)
|
||||
' Sets the given property of the given section in the given form to the given value
|
||||
' If Formname="" then all forms
|
||||
' If Sectionname="" then all sections
|
||||
|
||||
Dim sec1 As Section
|
||||
Dim ctl1 As Control
|
||||
Dim i As Integer
|
||||
|
||||
If FormName = "" Or IsNull(FormName) Then
|
||||
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
Set db1 = CurrentDb
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Forms" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
DoCmd.OpenForm doc1.Name, acDesign
|
||||
'Search all Sections for desired Control
|
||||
For i = 0 To 4
|
||||
On Error Resume Next
|
||||
Set sec1 = Forms(doc1.Name).Section(i)
|
||||
If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
|
||||
sec1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
Next doc1
|
||||
End If
|
||||
Next cnt1
|
||||
|
||||
Else
|
||||
DoCmd.OpenForm FormName, acDesign
|
||||
For i = 0 To 4
|
||||
Set sec1 = Forms(FormName).Section(i)
|
||||
If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
|
||||
On Error Resume Next
|
||||
sec1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function GetFormControlProperty(FormName As String, ControlName As String, PropertyName As String) As Variant
|
||||
|
||||
Dim sec1 As Section
|
||||
Dim ctl1 As Control
|
||||
Dim i As Integer
|
||||
|
||||
'Search all Sections for desired Control
|
||||
|
||||
DoCmd.OpenForm FormName, acDesign
|
||||
For i = 0 To 4
|
||||
Set sec1 = Forms(FormName).Section(i)
|
||||
For Each ctl1 In sec1.Controls
|
||||
If ctl1.Name = ControlName Then
|
||||
GetFormControlProperty = ctl1.Properties(PropertyName)
|
||||
i = 9
|
||||
Exit For
|
||||
End If
|
||||
Next ctl1
|
||||
Next i
|
||||
DoCmd.Close
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function SetReportProperty(reportname As String, PropertyName As String, PropertyValue As Variant)
|
||||
'Set Report Property, if Report Name="" then all Reports
|
||||
|
||||
If reportname = "" Or IsNull(reportname) Then
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
Set db1 = CurrentDb
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Reports" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
DoCmd.OpenReport doc1.Name, acDesign
|
||||
On Error Resume Next
|
||||
Reports(doc1.Name).Properties(PropertyName) = PropertyValue
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
Next doc1
|
||||
End If
|
||||
Next cnt1
|
||||
Else
|
||||
DoCmd.OpenReport reportname, acViewDesign
|
||||
Reports(reportname).Properties(PropertyName) = PropertyValue
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function GetReportProperty(reportname As String, PropertyName As String) As Variant
|
||||
'Read Form Property
|
||||
|
||||
DoCmd.OpenReport reportname, acViewDesign
|
||||
GetReportProperty = Reports(reportname).Properties(PropertyName)
|
||||
DoCmd.Close
|
||||
|
||||
End Function
|
||||
|
||||
Function SetReportControlProperty(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant)
|
||||
' Sets the given property of the given control in the given form to the given value
|
||||
' If Formname="" then all forms
|
||||
' If Controlname="" then all controls
|
||||
|
||||
Dim sec1 As Section
|
||||
Dim ctl1 As Control
|
||||
Dim i As Integer
|
||||
|
||||
If reportname = "" Or IsNull(reportname) Then
|
||||
'All Reports
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
Set db1 = CurrentDb
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Reports" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
DoCmd.OpenReport doc1.Name, acViewDesign
|
||||
'Search all Sections for desired Control
|
||||
For i = 0 To 8
|
||||
Set sec1 = Reports(doc1.Name).Section(i)
|
||||
For Each ctl1 In sec1.Controls
|
||||
If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
|
||||
If Controltype = ctl1.Controltype Or Controltype = -1 Then
|
||||
On Error Resume Next
|
||||
ctl1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
End If
|
||||
Next ctl1
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
Next doc1
|
||||
End If
|
||||
Next cnt1
|
||||
|
||||
Else
|
||||
DoCmd.OpenReport reportname, acViewDesign
|
||||
For i = 0 To 8
|
||||
Set sec1 = Reports(reportname).Section(i)
|
||||
For Each ctl1 In sec1.Controls
|
||||
If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
|
||||
On Error Resume Next
|
||||
ctl1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
Next ctl1
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function GetReportControlProperty(reportname As String, ControlName As String, PropertyName As String) As Variant
|
||||
|
||||
Dim sec1 As Section
|
||||
Dim ctl1 As Control
|
||||
Dim i As Integer
|
||||
|
||||
'Search all Sections for desired Control
|
||||
|
||||
DoCmd.OpenReport reportname, acDesign
|
||||
For i = 0 To 4
|
||||
Set sec1 = Reports(reportname).Section(i)
|
||||
For Each ctl1 In sec1.Controls
|
||||
If ctl1.Name = ControlName Then
|
||||
On Error Resume Next
|
||||
GetReportControlProperty = ctl1.Properties(PropertyName)
|
||||
i = 9
|
||||
Exit For
|
||||
End If
|
||||
Next ctl1
|
||||
Next i
|
||||
DoCmd.Close
|
||||
|
||||
End Function
|
||||
|
||||
Function SetReportSectionProperty(reportname As String, SectionName As String, PropertyName As String, PropertyValue As Variant)
|
||||
' Sets the given property of the given control in the given form to the given value
|
||||
' If Formname="" then all forms
|
||||
' If Controlname="" then all controls
|
||||
|
||||
Dim sec1 As Section
|
||||
Dim ctl1 As Control
|
||||
Dim i As Integer
|
||||
|
||||
If reportname = "" Or IsNull(reportname) Then
|
||||
'All Reports
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
Set db1 = CurrentDb
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Reports" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
DoCmd.OpenReport doc1.Name, acViewDesign
|
||||
'Search all Sections for desired Control
|
||||
For i = 0 To 8
|
||||
On Error Resume Next
|
||||
Set sec1 = Reports(doc1.Name).Section(i)
|
||||
If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
|
||||
On Error Resume Next
|
||||
sec1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
Next doc1
|
||||
End If
|
||||
Next cnt1
|
||||
|
||||
Else
|
||||
DoCmd.OpenReport reportname, acViewDesign
|
||||
For i = 0 To 8
|
||||
Set sec1 = Reports(reportname).Section(i)
|
||||
If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
|
||||
On Error Resume Next
|
||||
sec1.Properties(PropertyName) = PropertyValue
|
||||
End If
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function SetLinkTablePath(TableName As String, path1 As String)
|
||||
'Set Table Property, if Tablename="" then set Property of all Tables
|
||||
Dim db1 As Database
|
||||
Dim tdf1 As TableDef
|
||||
Set db1 = CurrentDb
|
||||
|
||||
For Each tdf1 In db1.TableDefs
|
||||
If TableName = tdf1.Name Or TableName = "" Or IsNull(TableName) Then
|
||||
If (Left(tdf1.Name, 1) = "T" And TableName = "") Or TableName <> "" Then
|
||||
tdf1.connect = ";DATABASE=" + path1
|
||||
On Error Resume Next
|
||||
tdf1.RefreshLink
|
||||
End If
|
||||
End If
|
||||
Next tdf1
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
' Example for easy usage : set form backgroundcolors
|
||||
|
||||
Function SetBackGroundColor_AllForms(r As Long, g As Long, b As Long)
|
||||
|
||||
SetFormSectionProperty "", "", "Backcolor", RGB(r, g, b)
|
||||
'SetFormControlProperty "", "", -1, "Backcolor", RGB(r, g, b)
|
||||
'SetFormControlProperty "", "", acTextBox, "Backcolor", RGB(255, 255, 255)
|
||||
'SetFormControlProperty "", "", acComboBox, "Backcolor", RGB(255, 255, 255)
|
||||
'SetFormControlProperty "", "", acListBox, "Backcolor", RGB(255, 255, 255)
|
||||
|
||||
End Function
|
||||
|
||||
Sub test()
|
||||
|
||||
'SetBackGroundColor_AllForms &HEE, &HFF, &HEE
|
||||
'SetFormControlProperty "", "", acTextBox, "FontSize", 9
|
||||
SetFormControlProperty "", "", acComboBox, "FontSize", 9
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function SetDefaultDataPath()
|
||||
|
||||
|
||||
SetLinkTablePath "", GetAppPath + "WGLEER.ACCDB"
|
||||
SetLinkTablePath "Mandanten", GetAppPath + "WGMANDNT.ACCDB"
|
||||
|
||||
End Function
|
||||
|
||||
@ -1,407 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Sub TanksRoeschitzAnlegen()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim i As Integer
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("TBehaelter")
|
||||
|
||||
For i = 1 To 14
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 99000
|
||||
If i = 14 Then
|
||||
rs1("MaxMenge") = 72600
|
||||
End If
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 3
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 15 To 16
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 600000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 2
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
|
||||
For i = 17 To 22
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 15000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 6
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 23 To 38
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 30000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 6
|
||||
If i = 35 Then
|
||||
rs1("BSNR") = 2
|
||||
End If
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
|
||||
For i = 39 To 39
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 5000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 6
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 40 To 42
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 7000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 6
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 43 To 50
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 3000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 6
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 51 To 53
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "T" + Format(i)
|
||||
rs1("Bezeichnung") = "Tank " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 1500
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 6
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 9 To 23
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "Z" + Format(i)
|
||||
rs1("Bezeichnung") = "Zisterne " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 25000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("BevorzugterSortenTyp") = "Rot"
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 4
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 1 To 3
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "F" + Format(i)
|
||||
rs1("Bezeichnung") = "Fass " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 9000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("BevorzugterSortenTyp") = "Rot"
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 5
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
|
||||
rs1.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub PositionenTanksRoeschitz()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim i As Integer
|
||||
|
||||
Dim offset_x As Long
|
||||
Dim offset_y As Long
|
||||
Dim raster_x As Long
|
||||
Dim raster_y As Long
|
||||
Dim max_x As Long
|
||||
Dim current_x As Long
|
||||
Dim current_y As Long
|
||||
|
||||
offset_x = 100
|
||||
offset_y = 550
|
||||
raster_x = 2000
|
||||
raster_y = 2000
|
||||
max_x = 14000
|
||||
Set db1 = CurrentDb
|
||||
For i = 1 To 7
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BSNR=" + Format(i) + " order by BNR")
|
||||
current_x = offset_x
|
||||
current_y = offset_y
|
||||
While Not rs1.EOF
|
||||
rs1.Edit
|
||||
rs1("Pos_X") = current_x
|
||||
rs1("Pos_Y") = current_y
|
||||
rs1.Update
|
||||
current_x = current_x + raster_x
|
||||
If current_x > max_x Then
|
||||
current_x = offset_x
|
||||
current_y = current_y + raster_x
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub TanksWinzerkellerAnlegen()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim i As Integer
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("TBehaelter")
|
||||
|
||||
For i = 1 To 12
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "MB" + Format(i)
|
||||
rs1("Bezeichnung") = "Weißwein Maischebehälter " + Format(i)
|
||||
rs1("BTNR") = 2
|
||||
rs1("MaxMenge") = 12000
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("BevorzugterSortenTyp") = "Weiß"
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "kg"
|
||||
rs1("BSNR") = 1
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 1 To 5
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "RT" + Format(i)
|
||||
rs1("Bezeichnung") = "Rührtanks Rotwein " + Format(i)
|
||||
rs1("BTNR") = 3
|
||||
rs1("MaxMenge") = 18000
|
||||
If i > 2 Then
|
||||
rs1("MaxMenge") = 30000
|
||||
End If
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("BevorzugterSortenTyp") = "Rot"
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "kg"
|
||||
rs1("BSNR") = 1
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 1 To 4
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "P" + Format(i)
|
||||
rs1("Bezeichnung") = "Presse " + Format(i)
|
||||
rs1("BTNR") = 1
|
||||
rs1("MaxMenge") = 30000
|
||||
rs1("Reduktionsfaktor") = 0.8
|
||||
'rs1("BevorzugterSortenTyp") = ""
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "kg"
|
||||
rs1("BSNR") = 1
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 1 To 5
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "W" + Format(i)
|
||||
rs1("Bezeichnung") = "Weißwein-Mosttank " + Format(i)
|
||||
rs1("BTNR") = 4
|
||||
rs1("MaxMenge") = 32000
|
||||
If i = 1 Or i = 4 Then rs1("MaxMenge") = 50000
|
||||
rs1("BevorzugterSortenTyp") = "Weiß"
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 2
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
For i = 6 To 9
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "R" + Format(i)
|
||||
rs1("Bezeichnung") = "Rotwein-Mosttank " + Format(i)
|
||||
rs1("BTNR") = 4
|
||||
rs1("MaxMenge") = 26000
|
||||
If i = 9 Then rs1("MaxMenge") = 50000
|
||||
rs1("BevorzugterSortenTyp") = "Weiß"
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "l"
|
||||
rs1("BSNR") = 2
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
|
||||
For i = 1 To 3
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "V" + Format(i)
|
||||
rs1("Bezeichnung") = "Rotwein-Mosttank " + Format(i)
|
||||
rs1("BTNR") = 6
|
||||
rs1("MaxMenge") = 12000
|
||||
rs1("BevorzugterSortenTyp") = "Rot"
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "kg"
|
||||
rs1("BSNR") = 1
|
||||
rs1.Update
|
||||
Next i
|
||||
|
||||
'Scheitermost
|
||||
rs1.AddNew
|
||||
rs1("Kurzbezeichnung") = "ST" + Format(10)
|
||||
rs1("Bezeichnung") = "Scheitermosttank " + Format(10)
|
||||
rs1("BTNR") = 4
|
||||
rs1("MaxMenge") = 32000
|
||||
rs1("BevorzugterSortenTyp") = "Weiß"
|
||||
rs1("Reduktionsfaktor") = 1
|
||||
rs1("Pos_X") = 100
|
||||
rs1("Pos_Y") = 4100
|
||||
rs1("MengenEinheit") = "kg"
|
||||
rs1("BSNR") = 1
|
||||
rs1.Update
|
||||
|
||||
|
||||
|
||||
rs1.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub PositionenTanksWinzerkeller()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim i As Integer
|
||||
|
||||
Dim offset_x As Long
|
||||
Dim offset_y As Long
|
||||
Dim raster_x As Long
|
||||
Dim raster_y As Long
|
||||
Dim max_x As Long
|
||||
Dim current_x As Long
|
||||
Dim current_y As Long
|
||||
Dim x As String
|
||||
|
||||
offset_x = 100
|
||||
offset_y = 550
|
||||
raster_x = 1700
|
||||
raster_y = 1900
|
||||
max_x = 14000
|
||||
Set db1 = CurrentDb
|
||||
For i = 1 To 2
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TBehaelter WHERE BSNR=" + Format(i) + " order by BNR")
|
||||
current_x = offset_x
|
||||
current_y = offset_y
|
||||
While Not rs1.EOF
|
||||
rs1.Edit
|
||||
rs1("Pos_X") = current_x
|
||||
rs1("Pos_Y") = current_y
|
||||
rs1.Update
|
||||
current_x = current_x + raster_x
|
||||
'If MsgBox("Momentaner Behälter=" + Format(rs1("Kurzbezeichnung")) + ". Zeilenumbruch?", vbYesNo) = vbYes Then
|
||||
' current_x = offset_x
|
||||
' current_y = current_y + raster_x
|
||||
'End If
|
||||
x = rs1("Kurzbezeichnung")
|
||||
|
||||
If x = "MB6" Or x = "MB12" Or x = "RT5" Or x = "P4" Then
|
||||
current_x = offset_x
|
||||
current_y = current_y + raster_x
|
||||
End If
|
||||
|
||||
|
||||
If current_x > max_x Then
|
||||
current_x = offset_x
|
||||
current_y = current_y + raster_x
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
@ -1,215 +0,0 @@
|
||||
Option Compare Database
|
||||
|
||||
' Fügen sie diesen Code in ein öffentliches Modul ein
|
||||
Private Declare Function gethostbyname Lib "wsock32.dll" ( _
|
||||
ByVal Name As String) As Long
|
||||
Private Declare Function socket Lib "wsock32.dll" ( _
|
||||
ByVal af As Long, _
|
||||
ByVal prototype As Long, _
|
||||
ByVal protocol As Long) As Long
|
||||
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
|
||||
Private Declare Function connect Lib "wsock32.dll" ( _
|
||||
ByVal s As Long, _
|
||||
Name As SOCKADDR, _
|
||||
ByVal namelen As Long) As Long
|
||||
Private Declare Function send Lib "wsock32.dll" ( _
|
||||
ByVal s As Long, _
|
||||
buf As Any, _
|
||||
ByVal length As Long, _
|
||||
ByVal flags As Long) As Long
|
||||
Private Declare Function recv Lib "wsock32.dll" ( _
|
||||
ByVal s As Long, _
|
||||
buf As Any, _
|
||||
ByVal length As Long, _
|
||||
ByVal flags As Long) As Long
|
||||
Private Declare Function ioctlsocket Lib "wsock32.dll" ( _
|
||||
ByVal s As Long, _
|
||||
ByVal cmd As Long, _
|
||||
argp As Long) As Long
|
||||
Private Declare Function inet_addr Lib "wsock32.dll" ( _
|
||||
ByVal cp As String) As Long
|
||||
Private Declare Function htons Lib "wsock32.dll" ( _
|
||||
ByVal hostshort As Integer) As Integer
|
||||
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
|
||||
Private Declare Sub MoveMemory Lib "kernel32" _
|
||||
Alias "RtlMoveMemory" ( _
|
||||
Destination As Any, _
|
||||
Source As Any, _
|
||||
ByVal length As Long)
|
||||
|
||||
Private Declare Function WSAStartup Lib "wsock32.dll" ( _
|
||||
ByVal wVersionRequested As Integer, _
|
||||
lpWSAData As WSAData) As Long
|
||||
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
|
||||
|
||||
Private Type HOSTENT
|
||||
hname As Long
|
||||
haliases As Long
|
||||
haddrtype As Integer
|
||||
hlength As Integer
|
||||
haddrlist As Long
|
||||
End Type
|
||||
|
||||
Private Type SOCKADDR
|
||||
sin_family As Integer
|
||||
sin_port As Integer
|
||||
sin_addr As Long
|
||||
sin_zero As String * 8
|
||||
End Type
|
||||
|
||||
Private Type WSAData
|
||||
wVersion As Integer
|
||||
wHighVersion As Integer
|
||||
szDescription As String * 257
|
||||
szSystemStatus As String * 129
|
||||
iMaxSockets As Long
|
||||
iMaxUdpDg As Long
|
||||
lpVendorInfo As Long
|
||||
End Type
|
||||
|
||||
|
||||
|
||||
' eine der HOSTENT-haddrtype-Konstanten
|
||||
Private Const AF_INET = 2 ' Internet Protokoll (UDP/IP oder TCP/IP).
|
||||
|
||||
' socket prototype-Konstanten
|
||||
Private Const SOCK_STREAM = 1 ' 2-wege Stream. Bei AF_INET ist es das
|
||||
' TCP/IP Protokoll
|
||||
Private Const SOCK_DGRAM = 2 ' Datagramm Basierende verbindung. Bei AF_INET
|
||||
' ist es das UDP Protokoll
|
||||
|
||||
' recv flags-Konstanten
|
||||
Private Const MSG_PEEK = &H2 ' Daten aus dem Puffer lesen, aber nicht aus
|
||||
' dem Puffer entfernen
|
||||
|
||||
' ioctlsocket cmd-Konstanten
|
||||
Private Const FIONBIO = &H8004667E ' Setzen ob die Funktion bei der nächsten
|
||||
' Datenanfrage zurückkehren soll
|
||||
|
||||
Dim hSock As Long
|
||||
|
||||
|
||||
' IP-Adresse einer Internetadresse ermitteln
|
||||
Public Function GetIP(ByVal HostName As String) As String
|
||||
Dim pHost As Long, HostInfo As HOSTENT
|
||||
Dim pIP As Long, IPArray(3) As Byte
|
||||
|
||||
' Informationen des Host ermitteln
|
||||
pHost = gethostbyname(HostName)
|
||||
If pHost = 0 Then Exit Function
|
||||
|
||||
' HOSTENT-Struktur kopieren
|
||||
MoveMemory HostInfo, ByVal pHost, Len(HostInfo)
|
||||
|
||||
' Pointer der 1ten Ip-Adresse ermitteln
|
||||
ReDim IpAddress(HostInfo.hlength - 1)
|
||||
MoveMemory pIP, ByVal HostInfo.haddrlist, 4
|
||||
MoveMemory IPArray(0), ByVal pIP, 4
|
||||
|
||||
GetIP = IPArray(0) & "." & IPArray(1) & "." & IPArray(2) & "." & IPArray(3)
|
||||
End Function
|
||||
|
||||
' Mit einem Server verbinden
|
||||
Public Function ConnectToServer(ByVal ServerIP As String, ByVal ServerPort _
|
||||
As Long) As Long
|
||||
Dim Retval As Long, ServerAddr As SOCKADDR
|
||||
|
||||
' Socket erstellen
|
||||
hSock = socket(AF_INET, SOCK_STREAM, 0&)
|
||||
If hSock = -1 Then
|
||||
ConnectToServer = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' mit dem Server verbinden
|
||||
With ServerAddr
|
||||
.sin_addr = inet_addr(ServerIP)
|
||||
.sin_port = htons(ServerPort)
|
||||
.sin_family = AF_INET
|
||||
End With
|
||||
Retval = connect(hSock, ServerAddr, Len(ServerAddr))
|
||||
If Retval < 0 Then
|
||||
MsgBox ("Connection Error:" + Retval)
|
||||
Call closesocket(hSock)
|
||||
ConnectToServer = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' Rückkehren der Funktion nach dem Abfragen von ankommenden Daten erzwingen
|
||||
Retval = ioctlsocket(hSock, FIONBIO, 1&)
|
||||
|
||||
' Socket-ID zurückgeben
|
||||
ConnectToServer = hSock
|
||||
End Function
|
||||
|
||||
' Sock/Verbindung schließen
|
||||
Public Function Disconnect(ByRef Sock As Long)
|
||||
Call closesocket(hSock)
|
||||
Sock = 0
|
||||
End Function
|
||||
|
||||
' Daten senden
|
||||
Public Function SendData(ByVal Data As String) As Long
|
||||
SendData = send(hSock, ByVal Data, Len(Data), 0&)
|
||||
End Function
|
||||
|
||||
' Sind Daten angekommen ?
|
||||
Public Function DataComeIn() As Long
|
||||
Dim Tmpstr As String * 1
|
||||
|
||||
DataComeIn = recv(hSock, ByVal Tmpstr, Len(Tmpstr), MSG_PEEK)
|
||||
If DataComeIn = -1 Then
|
||||
DataComeIn = WSAGetLastError()
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Daten ermitteln
|
||||
Public Function GetData() As String
|
||||
Dim Tmpstr As String * 4096, Retval As Long
|
||||
|
||||
Retval = recv(hSock, ByVal Tmpstr, Len(Tmpstr), 0&)
|
||||
GetData = Left$(Tmpstr, Retval)
|
||||
End Function
|
||||
|
||||
' Fügen Sie diesen Code in eine Form mit einem Command-Button und einem
|
||||
' Textfeld ein
|
||||
|
||||
|
||||
Public Function StartWinSocket() As Long
|
||||
|
||||
Dim Retval As Long, WSD As WSAData
|
||||
|
||||
Retval = WSAStartup(&H202, WSD)
|
||||
If Retval < 0 Then
|
||||
StartWinSocket = -1
|
||||
End If
|
||||
|
||||
StartWinSocket = 0
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Public Sub EndWinSocket()
|
||||
|
||||
Call Disconnect(hSock)
|
||||
Call WSACleanup
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Public Function ReceiveString(length) As String
|
||||
|
||||
Dim resultString As String
|
||||
|
||||
While Len(resultString) < length
|
||||
|
||||
While DataComeIn() = 0
|
||||
DoEvents
|
||||
Wend
|
||||
|
||||
resultString = resultString + GetData()
|
||||
|
||||
Wend
|
||||
ReceiveString = resultString
|
||||
|
||||
End Function
|
||||
@ -1,995 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Dim tcpConnectionKeepAlive As Boolean
|
||||
Dim tcpConnectionOpen As Boolean
|
||||
|
||||
Sub WiegenInitialisieren()
|
||||
|
||||
tcpConnectionOpen = False
|
||||
tcpConnectionKeepAlive = True
|
||||
|
||||
End Sub
|
||||
|
||||
Sub WiegenBeenden()
|
||||
|
||||
If tcpConnectionOpen = True Then
|
||||
EndWinSocket
|
||||
tcpConnectionOpen = False
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Function Wiegen(Optional Datum As Date, Optional zeit As Date, Optional Gewicht As Long, Optional Waagentext As String, Optional KeineIdentNummernErhöhung As Boolean) As Long
|
||||
|
||||
Dim waagentyp1
|
||||
|
||||
waagentyp1 = GetParameter("WAAGENTYP")
|
||||
|
||||
Wiegen = -1
|
||||
|
||||
If waagentyp1 = "TOLEDO" Then
|
||||
Wiegen = WiegenToledo
|
||||
End If
|
||||
|
||||
If waagentyp1 = "GASSNER" Then
|
||||
Wiegen = WiegenGassner(Datum, zeit, Gewicht, Waagentext)
|
||||
End If
|
||||
|
||||
If waagentyp1 = "SCHEMBER" Then
|
||||
Wiegen = WiegenSchember
|
||||
End If
|
||||
|
||||
If waagentyp1 = "SYSTEC" Then
|
||||
Wiegen = WiegenSystec
|
||||
End If
|
||||
|
||||
If waagentyp1 = "IT3000" Then
|
||||
Wiegen = WiegenIt3000(Datum, zeit, Gewicht)
|
||||
End If
|
||||
|
||||
If waagentyp1 = "IT3000A" Then
|
||||
Wiegen = WiegenIt3000a(Datum, zeit, Gewicht, Waagentext, KeineIdentNummernErhöhung)
|
||||
End If
|
||||
|
||||
If waagentyp1 = "L320" Then
|
||||
Wiegen = L320(Datum, zeit, Gewicht, Waagentext)
|
||||
End If
|
||||
|
||||
If waagentyp1 = "L246" Then
|
||||
Wiegen = L246(Datum, zeit, Gewicht, Waagentext, KeineIdentNummernErhöhung)
|
||||
End If
|
||||
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function WiegenToledo() As Long
|
||||
' Wolkersdorf, Haugsdorf
|
||||
|
||||
Dim buff(0 To 11) As Integer
|
||||
Dim i, c As Integer
|
||||
Dim str1 As String
|
||||
|
||||
' Send command "netto weight": "CP"
|
||||
Forms!FÜbernahme.send (Asc("C"))
|
||||
Forms!FÜbernahme.TheEvent = 0
|
||||
While Forms!FÜbernahme.TheEvent < 1
|
||||
DoEvents
|
||||
Wend
|
||||
Forms!FÜbernahme!XComm.InBufferCount = 0
|
||||
Forms!FÜbernahme.send (Asc("P"))
|
||||
|
||||
' Read whole response word: 12 Bytes
|
||||
While i < 12 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
buff(i) = c
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
If c = -1 Then
|
||||
WiegenToledo = -1
|
||||
Exit Function
|
||||
Else
|
||||
'Number of read bytes OK
|
||||
|
||||
'Check if format is OK
|
||||
|
||||
'First byte: 02
|
||||
If buff(0) <> 2 Then
|
||||
WiegenToledo = -2
|
||||
Exit Function
|
||||
End If
|
||||
'Bytes 9 and 10: 'kg'
|
||||
If buff(8) <> Asc("k") Then
|
||||
WiegenToledo = -3
|
||||
Exit Function
|
||||
End If
|
||||
If buff(9) <> Asc("g") Then
|
||||
WiegenToledo = -3
|
||||
Exit Function
|
||||
End If
|
||||
'Bytes 11 and 12: 0D 0A (CRLF)
|
||||
If buff(10) <> &HD Then
|
||||
WiegenToledo = -4
|
||||
Exit Function
|
||||
End If
|
||||
If buff(11) <> &HA Then
|
||||
WiegenToledo = -5
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Convert weight to long value
|
||||
str1 = ""
|
||||
For i = 1 To 7
|
||||
str1 = str1 + Chr(buff(i))
|
||||
Next i
|
||||
c = CLng(str1)
|
||||
|
||||
WiegenToledo = c
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Function WiegenGassner(Datum As Variant, zeit As Variant, Gewicht As Long, Waagentext As Variant) As Long
|
||||
'im Moment nirgends
|
||||
|
||||
Dim buff(0 To 99) As Integer
|
||||
Dim i, c As Integer
|
||||
Dim str1 As String
|
||||
Dim str2 As String
|
||||
Dim waagennummer As Long
|
||||
Dim speichernummer As Long
|
||||
|
||||
' Send command "ENQ": 05h
|
||||
Forms!FÜbernahme!XComm.InBufferCount = 0
|
||||
Forms!FÜbernahme.send (&H5)
|
||||
Forms!FÜbernahme.TheEvent = 0
|
||||
|
||||
' Read whole response word: 25 Bytes
|
||||
While i < 47 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
buff(i) = c
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
'str1 = ""
|
||||
'For i = 0 To 46
|
||||
' str1 = str1 + Hex(buff(i)) + " "
|
||||
' str2 = str2 + Chr(buff(i))
|
||||
'Next i
|
||||
'MsgBox (str1 + Chr(10) + Chr(13) + str2)
|
||||
|
||||
If c = -1 Then
|
||||
WiegenGassner = -1
|
||||
Exit Function
|
||||
Else
|
||||
'Number of read bytes OK
|
||||
|
||||
'Check if format is OK
|
||||
|
||||
'First byte: 02
|
||||
If buff(0) <> 2 Then
|
||||
WiegenGassner = -2
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Second byte: "E"/"S" (" "..OK, "E" for Error)
|
||||
If buff(1) <> Asc(" ") Then
|
||||
WiegenGassner = -3
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Third byte: "S"/"M"
|
||||
If buff(2) <> Asc("S") Then
|
||||
WiegenGassner = -4
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Convert weight to long value
|
||||
str1 = ""
|
||||
For i = 0 To 6
|
||||
str1 = str1 + Chr(buff(i + 17))
|
||||
Next i
|
||||
c = CLng(str1)
|
||||
Gewicht = c
|
||||
WiegenGassner = c
|
||||
|
||||
'Convert weight to long value
|
||||
str1 = ""
|
||||
For i = 0 To 6
|
||||
str1 = str1 + Chr(buff(i + 17))
|
||||
Next i
|
||||
c = CLng(str1)
|
||||
Gewicht = c
|
||||
WiegenGassner = c
|
||||
|
||||
'Convert Waagennummer
|
||||
str1 = ""
|
||||
For i = 0 To 1
|
||||
str1 = str1 + Chr(buff(i + 24))
|
||||
Next i
|
||||
c = CLng(str1)
|
||||
waagennummer = c
|
||||
|
||||
'Convert Speichernummer
|
||||
str1 = ""
|
||||
For i = 0 To 5
|
||||
str1 = str1 + Chr(buff(i + 26))
|
||||
Next i
|
||||
c = CLng(str1)
|
||||
speichernummer = c
|
||||
|
||||
'Convert Datum
|
||||
str1 = ""
|
||||
For i = 0 To 7
|
||||
str1 = str1 + Chr(buff(i + 32))
|
||||
Next i
|
||||
If IsDate(Mid(str1, 7, 2) + "." + Mid(str1, 5, 2) + "." + Mid(str1, 1, 4)) Then
|
||||
Datum = DateValue(Mid(str1, 7, 2) + "." + Mid(str1, 5, 2) + "." + Mid(str1, 1, 4))
|
||||
End If
|
||||
|
||||
'Convert Zeit
|
||||
str1 = ""
|
||||
For i = 0 To 5
|
||||
str1 = str1 + Chr(buff(i + 40))
|
||||
Next i
|
||||
If IsDate(Mid(str1, 1, 2) + ":" + Mid(str1, 3, 2) + ":" + Mid(str1, 5, 2)) Then
|
||||
zeit = TimeValue(Mid(str1, 1, 2) + ":" + Mid(str1, 3, 2) + ":" + Mid(str1, 5, 2))
|
||||
End If
|
||||
Waagentext = "Waagennummer: " + Format(waagennummer) + " Speichernummer: " + Format(speichernummer)
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Function WiegenGassnerAlt() As Long
|
||||
'im Moment nirgends
|
||||
|
||||
Dim buff(0 To 24) As Integer
|
||||
Dim i, c As Integer
|
||||
Dim str1 As String
|
||||
|
||||
' Send command "ENQ": 05h
|
||||
Forms!FÜbernahme!XComm.InBufferCount = 0
|
||||
Forms!FÜbernahme.send (&H5)
|
||||
Forms!FÜbernahme.TheEvent = 0
|
||||
|
||||
' Read whole response word: 25 Bytes
|
||||
While i < 25 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
buff(i) = c
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
If c = -1 Then
|
||||
WiegenGassnerAlt = -1
|
||||
Exit Function
|
||||
Else
|
||||
'Number of read bytes OK
|
||||
|
||||
'Check if format is OK
|
||||
|
||||
'First byte: 02
|
||||
If buff(0) <> 2 Then
|
||||
WiegenGassnerAlt = -2
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Second byte: "E"/"S" (" "..OK, "E" for Error)
|
||||
If buff(1) <> " " Then
|
||||
WiegenGassnerAlt = -3
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Third byte: "S"/"M"
|
||||
If buff(2) <> "S" Then
|
||||
WiegenGassnerAlt = -4
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Byte 25
|
||||
'If buff(24) <> &H3 Then
|
||||
' WiegenGassner = -5
|
||||
' Exit Function
|
||||
'End If
|
||||
|
||||
'Convert weight to long value
|
||||
str1 = ""
|
||||
For i = 0 To 6
|
||||
str1 = str1 + Chr(buff(i + 17))
|
||||
Next i
|
||||
c = CLng(str1)
|
||||
|
||||
WiegenGassnerAlt = c
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Function WiegenSchember() As Long
|
||||
|
||||
' Matzen
|
||||
|
||||
Dim buff(0 To 24) As Integer
|
||||
Dim i, c As Integer
|
||||
Dim str1 As String
|
||||
|
||||
' Send command "27,62"
|
||||
Forms!FÜbernahme.send (27)
|
||||
Forms!FÜbernahme.TheEvent = 0
|
||||
While Forms!FÜbernahme.TheEvent < 1
|
||||
DoEvents
|
||||
Wend
|
||||
Forms!FÜbernahme.XComm.InBufferCount = 0
|
||||
Forms!FÜbernahme.send (62)
|
||||
|
||||
' Read whole response word: 12 Bytes
|
||||
While i < 25 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
buff(i) = c
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
If c = -1 Then
|
||||
WiegenSchember = -1
|
||||
Exit Function
|
||||
Else
|
||||
'Number of read bytes OK
|
||||
|
||||
'Check if format is OK
|
||||
|
||||
'First byte: 02
|
||||
If buff(0) <> 2 Then
|
||||
WiegenSchember = -2
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Bytes 11 and 12: 0D 0A (CRLF)
|
||||
If buff(24) <> 3 Then
|
||||
WiegenSchember = -4
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Convert weight to long value
|
||||
str1 = ""
|
||||
For i = 16 To 19
|
||||
str1 = str1 + Chr(buff(i))
|
||||
Next i
|
||||
str1 = str1 + ","
|
||||
str1 = str1 + Chr(buff(20))
|
||||
c = CDbl(str1)
|
||||
|
||||
|
||||
WiegenSchember = c
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function WiegenSystec() As Long
|
||||
|
||||
' Matzen
|
||||
|
||||
Dim buff(0 To 50) As Integer
|
||||
Dim i, c As Integer
|
||||
Dim str1 As String
|
||||
|
||||
|
||||
Forms!FÜbernahme.XComm.InBufferCount = 0
|
||||
|
||||
'Wait for STX
|
||||
Do
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
Loop Until c = 2
|
||||
buff(0) = c
|
||||
|
||||
i = 1
|
||||
While i < 17 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
buff(i) = c
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
If c = -1 Then
|
||||
WiegenSystec = -1
|
||||
Exit Function
|
||||
Else
|
||||
|
||||
'Number of read bytes OK
|
||||
|
||||
'Check if format is OK
|
||||
|
||||
'First byte: 02
|
||||
If buff(0) <> 2 Then
|
||||
WiegenSystec = -2
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'Convert weight to long value
|
||||
str1 = ""
|
||||
For i = 4 To 9
|
||||
str1 = str1 + Chr(buff(i))
|
||||
Next i
|
||||
c = CDbl(str1)
|
||||
|
||||
WiegenSystec = c
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function WiegenIt3000(Datum As Date, zeit As Date, Gewicht As Long) As Long
|
||||
' Röschitz
|
||||
|
||||
Dim c As Integer
|
||||
Dim recordcount As Integer
|
||||
Dim record(0 To 20) As String
|
||||
|
||||
'Receive STX
|
||||
While c <> 2 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
Wend
|
||||
If c = -1 Then
|
||||
WiegenIt3000 = -1
|
||||
Forms!FÜbernahme.send (&H15) 'NAK
|
||||
Exit Function
|
||||
End If
|
||||
'Receive Buffer and terminating ETX
|
||||
recordcount = 0
|
||||
record(recordcount) = ""
|
||||
While c <> -1 And c <> 3 'ETX
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
If c = Asc(";") Or c = 3 Then
|
||||
recordcount = recordcount + 1
|
||||
record(recordcount) = ""
|
||||
Else
|
||||
If c <> -1 Then
|
||||
record(recordcount) = record(recordcount) + Chr(c)
|
||||
End If
|
||||
End If
|
||||
Wend
|
||||
If c = -1 Then
|
||||
WiegenIt3000 = -2
|
||||
Forms!FÜbernahme.send (&H15) 'NAK
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'interpret records
|
||||
If recordcount < 4 Then
|
||||
'too less records
|
||||
WiegenIt3000 = -3
|
||||
Forms!FÜbernahme.send (&H15) 'NAK
|
||||
Exit Function
|
||||
End If
|
||||
'record(0) is waagennummer
|
||||
Datum = DateValue(record(1))
|
||||
zeit = TimeValue(record(2))
|
||||
Gewicht = Val(record(3))
|
||||
|
||||
'send acknowledge
|
||||
Forms!FÜbernahme.send (6) 'ACK
|
||||
|
||||
Forms!FÜbernahme!XComm.InBufferCount = 0
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Function WiegenIt3000a(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String, KeineIdentNummernErhöhung As Boolean) As Long
|
||||
' Matzen, Wolkersdorf
|
||||
|
||||
Dim c As Integer
|
||||
Dim i As Integer
|
||||
Dim Data As String
|
||||
Dim record As String
|
||||
Dim waagennummer As Long
|
||||
Dim speichernummer As Long
|
||||
|
||||
Forms!FÜbernahme.XComm.InBufferCount = 0
|
||||
Forms!FÜbernahme.TheEvent = 0
|
||||
|
||||
If KeineIdentNummernErhöhung = True Then
|
||||
'Send command
|
||||
Forms!FÜbernahme.send (Asc("<"))
|
||||
Forms!FÜbernahme.send (Asc("R"))
|
||||
Forms!FÜbernahme.send (Asc("M"))
|
||||
Forms!FÜbernahme.send (Asc(">"))
|
||||
Else
|
||||
'Send command
|
||||
Forms!FÜbernahme.send (Asc("<"))
|
||||
Forms!FÜbernahme.send (Asc("R"))
|
||||
Forms!FÜbernahme.send (Asc("N"))
|
||||
Forms!FÜbernahme.send (Asc(">"))
|
||||
End If
|
||||
|
||||
'Receive record
|
||||
i = 0
|
||||
Data = ""
|
||||
While i < 64 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
If c <> -1 Then
|
||||
Data = Data + Chr(c)
|
||||
End If
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
'MsgBox (data)
|
||||
|
||||
'skip < and >
|
||||
Data = Mid(Data, 2, 62)
|
||||
|
||||
|
||||
If c = -1 Then
|
||||
WiegenIt3000a = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'interpret data
|
||||
'1. Fehlercode, Waagenstatus
|
||||
record = Left(Data, 4)
|
||||
Data = Mid(Data, 5)
|
||||
If record <> "0000" Then
|
||||
WiegenIt3000a = -2
|
||||
Exit Function
|
||||
End If
|
||||
'2. Date
|
||||
record = Left(Data, 8)
|
||||
Data = Mid(Data, 9)
|
||||
If IsDate(record) Then
|
||||
Datum = DateValue(record)
|
||||
Else
|
||||
WiegenIt3000a = -3
|
||||
Exit Function
|
||||
End If
|
||||
'2. Time
|
||||
record = Left(Data, 5)
|
||||
record = record + ":00"
|
||||
Data = Mid(Data, 6)
|
||||
If IsDate(record) Then
|
||||
zeit = TimeValue(record)
|
||||
Else
|
||||
WiegenIt3000a = -4
|
||||
Exit Function
|
||||
End If
|
||||
'4. Identnr
|
||||
record = Left(Data, 4)
|
||||
Data = Mid(Data, 5)
|
||||
speichernummer = Val(record)
|
||||
'5. Waagennr
|
||||
record = Left(Data, 1)
|
||||
Data = Mid(Data, 2)
|
||||
waagennummer = Val(record)
|
||||
'6. Brutto
|
||||
record = Left(Data, 8)
|
||||
Data = Mid(Data, 9)
|
||||
'7. Tara
|
||||
record = Left(Data, 8)
|
||||
Data = Mid(Data, 9)
|
||||
'8. Netto
|
||||
record = Left(Data, 8)
|
||||
Data = Mid(Data, 9)
|
||||
If IsNumeric(record) Then
|
||||
Gewicht = Val(record)
|
||||
Else
|
||||
WiegenIt3000a = -5
|
||||
Exit Function
|
||||
End If
|
||||
'9. kg
|
||||
record = Left(Data, 2)
|
||||
Data = Mid(Data, 3)
|
||||
If record <> "kg" Then
|
||||
WiegenIt3000a = -6
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'rest wird nicht ausgewertet
|
||||
|
||||
Waagentext = "Waagenr: " + Format(waagennummer) + " ID: " + Format(speichernummer)
|
||||
|
||||
WiegenIt3000a = Gewicht
|
||||
|
||||
End Function
|
||||
|
||||
Sub testl320()
|
||||
|
||||
Dim Datum As Date
|
||||
Dim zeit As Date
|
||||
Dim Gewicht As Long
|
||||
Dim Waagentext As String
|
||||
Dim chk As String
|
||||
Dim Data As String
|
||||
|
||||
Data = " 17.04.14 12:58 2 72kg" + Chr(10)
|
||||
|
||||
Data = Mid(Data, 2)
|
||||
Datum = CDate(Left(Data, 8))
|
||||
Data = Mid(Data, 10)
|
||||
zeit = CDate(Left(Data, 5))
|
||||
Data = Mid(Data, 7)
|
||||
Waagentext = Left(Data, 4)
|
||||
Data = Mid(Data, 6)
|
||||
Gewicht = CLng(Left(Data, 9))
|
||||
Data = Mid(Data, 11)
|
||||
chk = Left(Data, 2)
|
||||
|
||||
MsgBox (Datum)
|
||||
MsgBox (zeit)
|
||||
MsgBox (Gewicht)
|
||||
MsgBox (Waagentext)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Function L320(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String) As Long
|
||||
|
||||
Dim c As Long
|
||||
Dim Data As String
|
||||
Dim chk As String
|
||||
Dim i As Integer
|
||||
Dim str1 As String
|
||||
'Receive record
|
||||
str1 = ""
|
||||
|
||||
Data = ""
|
||||
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
str1 = Format(c)
|
||||
'Forms!FÜbernahme!XComm.InBufferCount
|
||||
If c = 32 Then
|
||||
i = 1
|
||||
Data = Data + Chr(c)
|
||||
Else
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
str1 = str1 + "," + Format(c)
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
str1 = str1 + "," + Format(c)
|
||||
'MsgBox (str1)
|
||||
L320 = -9
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
While i < 33 And c <> -1
|
||||
c = Forms!FÜbernahme.Receive()
|
||||
If c <> -1 Then
|
||||
Data = Data + Chr(c)
|
||||
End If
|
||||
str1 = str1 + "," + Format(c)
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
'1: 0x20
|
||||
'2-9: Date 17.04.14
|
||||
'10 0x20
|
||||
'11-15: Time 12:58
|
||||
'16: 0x20
|
||||
'17-20: wiegenr
|
||||
'21: 0x20
|
||||
'22-30: gewicht
|
||||
'31-32: kg
|
||||
'33: 0x0A
|
||||
'MsgBox (str1 + ":" + Format(Len(data)) + ":" & data)
|
||||
If Len(Data) >= 33 Then
|
||||
Data = Mid(Data, 2)
|
||||
Datum = CDate(Left(Data, 8))
|
||||
Data = Mid(Data, 10)
|
||||
zeit = CDate(Left(Data, 5))
|
||||
Data = Mid(Data, 7)
|
||||
Waagentext = Left(Data, 4)
|
||||
Data = Mid(Data, 6)
|
||||
Gewicht = CLng(Left(Data, 9))
|
||||
Data = Mid(Data, 10)
|
||||
chk = Left(Data, 2)
|
||||
If chk <> "kg" Then
|
||||
'MsgBox ("Fehler! Waagenrecord nicht korrekt")
|
||||
L320 = -1
|
||||
Else
|
||||
L320 = Gewicht
|
||||
End If
|
||||
Else
|
||||
L320 = -9
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function L246(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String, KeineIdentNummernErhöhung As Boolean) As Long
|
||||
|
||||
' 1. open tcp port
|
||||
Dim host As String
|
||||
Dim tcpport As Long
|
||||
Dim result As Long
|
||||
|
||||
If tcpConnectionOpen = False Then
|
||||
host = GetParameter("WAAGEHOST")
|
||||
tcpport = GetParameter("WAAGETCPPORT")
|
||||
StartWinSocket
|
||||
result = ConnectToServer(host, tcpport)
|
||||
If result > 0 Then
|
||||
tcpConnectionOpen = True
|
||||
End If
|
||||
End If
|
||||
|
||||
If tcpConnectionOpen = True Then
|
||||
' 2. send command
|
||||
If (KeineIdentNummernErhöhung) Then
|
||||
SendData "<RM1>"
|
||||
Else
|
||||
SendData "<RN1>"
|
||||
End If
|
||||
|
||||
' 3. receive data
|
||||
Dim response As String
|
||||
|
||||
response = ReceiveString(65)
|
||||
|
||||
' 4. parse message
|
||||
'MsgBox (response)
|
||||
'Dim fehlerS As String
|
||||
Dim datumS As String
|
||||
Dim zeitS As String
|
||||
Dim identNrS As String
|
||||
Dim nettoS As String
|
||||
Dim waagennummerS As String
|
||||
Dim fehlerS As String
|
||||
|
||||
fehlerS = Mid(response, 2, 2)
|
||||
datumS = Mid(response, 6, 8)
|
||||
zeitS = Mid(response, 14, 5)
|
||||
identNrS = Mid(response, 19, 4)
|
||||
waagennummerS = Mid(response, 23, 1)
|
||||
nettoS = Mid(response, 40, 8)
|
||||
|
||||
|
||||
If fehlerS <> "00" Then
|
||||
MsgBox "Fehlermeldung Waage", vbCritical
|
||||
End If
|
||||
|
||||
Datum = CDate(datumS)
|
||||
zeit = CDate(zeitS)
|
||||
Waagentext = "Waagenr: " + Format(waagennummerS) + " ID: " + Format(identNrS)
|
||||
Gewicht = CLng(nettoS)
|
||||
|
||||
'MsgBox (datum)
|
||||
'MsgBox (zeit)
|
||||
'MsgBox (waagentext)
|
||||
'MsgBox (Gewicht)
|
||||
|
||||
|
||||
' 5. close port
|
||||
If tcpConnectionKeepAlive = False Then
|
||||
EndWinSocket
|
||||
tcpConnectionOpen = False
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Function KippenL246(onoff As Boolean)
|
||||
|
||||
Dim host As String
|
||||
Dim tcpport As Long
|
||||
Dim result As Long
|
||||
If tcpConnectionOpen = False Then
|
||||
host = GetParameter("WAAGEHOST")
|
||||
tcpport = GetParameter("WAAGETCPPORT")
|
||||
StartWinSocket
|
||||
result = ConnectToServer(host, tcpport)
|
||||
If result > 0 Then
|
||||
tcpConnectionOpen = True
|
||||
End If
|
||||
End If
|
||||
|
||||
If tcpConnectionOpen = True Then
|
||||
' 2. send command
|
||||
If onoff Then
|
||||
SendData "<OS02>"
|
||||
Else
|
||||
SendData "<OC02>"
|
||||
End If
|
||||
|
||||
' 3. receive data
|
||||
Dim response As String
|
||||
|
||||
response = ReceiveString(5)
|
||||
|
||||
' 4. parse message
|
||||
If Left(response, 4) <> "<00>" Then
|
||||
MsgBox "Fehler beim Ansteuern des digitalen Ausganges", vbCritical
|
||||
End If
|
||||
|
||||
' 5. close port
|
||||
If tcpConnectionKeepAlive = False Then
|
||||
EndWinSocket
|
||||
tcpConnectionOpen = False
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function FreigabeL246(onoff As Boolean)
|
||||
|
||||
Dim host As String
|
||||
Dim tcpport As Long
|
||||
Dim result As Long
|
||||
|
||||
If tcpConnectionOpen = False Then
|
||||
host = GetParameter("WAAGEHOST")
|
||||
tcpport = GetParameter("WAAGETCPPORT")
|
||||
StartWinSocket
|
||||
result = ConnectToServer(host, tcpport)
|
||||
If result > 0 Then
|
||||
tcpConnectionOpen = True
|
||||
End If
|
||||
End If
|
||||
|
||||
If tcpConnectionOpen = True Then
|
||||
' 2. send command
|
||||
If onoff Then
|
||||
SendData "<OS01>"
|
||||
Else
|
||||
SendData "<OC01>"
|
||||
End If
|
||||
|
||||
' 3. receive data
|
||||
Dim response As String
|
||||
|
||||
response = ReceiveString(5)
|
||||
|
||||
' 4. parse message
|
||||
If Left(response, 4) <> "<00>" Then
|
||||
MsgBox "Fehler beim Ansteuern des digitalen Ausganges", vbCritical
|
||||
End If
|
||||
|
||||
' 5. close port
|
||||
If tcpConnectionKeepAlive = False Then
|
||||
EndWinSocket
|
||||
tcpConnectionOpen = False
|
||||
End If
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub TestL246()
|
||||
|
||||
Dim Datum As Date
|
||||
Dim zeit As Date
|
||||
Dim Gewicht As Long
|
||||
Dim Waagentext As String
|
||||
|
||||
WiegenInitialisieren
|
||||
L246 Datum, zeit, Gewicht, Waagentext, True
|
||||
L246 Datum, zeit, Gewicht, Waagentext, True
|
||||
L246 Datum, zeit, Gewicht, Waagentext, True
|
||||
KippenL246 (True)
|
||||
KippenL246 (False)
|
||||
WiegenBeenden
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function Kippen(onoff As Boolean)
|
||||
|
||||
Dim steuerungtyp1
|
||||
Dim extbefehl
|
||||
|
||||
steuerungtyp1 = GetParameter("STEUERUNGTYP")
|
||||
|
||||
If steuerungtyp1 = "SERIELL" Then
|
||||
KippenSeriell (onoff)
|
||||
End If
|
||||
|
||||
If steuerungtyp1 = "PARALLEL" Then
|
||||
KippenParallel (onoff)
|
||||
End If
|
||||
|
||||
|
||||
If steuerungtyp1 = "L246" Then
|
||||
KippenL246 (onoff)
|
||||
End If
|
||||
|
||||
If steuerungtyp1 = "EXTERN" Then
|
||||
extbefehl = GetParameter("STEUERUNGEXTERN")
|
||||
If Not IsNull(extbefehl) And onoff = True Then
|
||||
Shell extbefehl, vbMinimizedFocus
|
||||
Else
|
||||
MsgBox "Externes Programm nicht gefunden!", vbCritical
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Function KippenSeriell(onoff As Boolean)
|
||||
|
||||
' Kippen: RTS Signal von COMx der Steuerung (i.a. COM2)
|
||||
' SubD 25: Pin 4, SubD 9: 7
|
||||
|
||||
Forms!FÜbernahme.XCommSteuerung.RTSEnable = onoff
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function KippenParallel(onoff As Boolean)
|
||||
|
||||
' Kippen: Über Datenleitungen des Ports
|
||||
|
||||
|
||||
Dim port1
|
||||
Dim tport1
|
||||
Dim databyte As Byte
|
||||
|
||||
port1 = GetParameter("STEUERUNGPORT")
|
||||
|
||||
If Not IsNull(port1) Then
|
||||
|
||||
Select Case port1
|
||||
|
||||
Case "1": tport1 = "LPT1"
|
||||
|
||||
Case "2": tport1 = "LPT2"
|
||||
|
||||
Case "3": tport1 = "LPT3"
|
||||
|
||||
End Select
|
||||
|
||||
End If
|
||||
|
||||
If onoff = True Then
|
||||
databyte = 255
|
||||
Else
|
||||
databyte = 0
|
||||
End If
|
||||
|
||||
Open tport1 For Binary Access Write As #1
|
||||
Put #1, , databyte
|
||||
|
||||
Close #1
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function Freigabe(onoff As Boolean)
|
||||
|
||||
Dim steuerungtyp1
|
||||
Dim extbefehl
|
||||
|
||||
steuerungtyp1 = GetParameter("STEUERUNGTYP")
|
||||
|
||||
If steuerungtyp1 = "L246" Then
|
||||
FreigabeL246 (onoff)
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub testkippen()
|
||||
|
||||
KippenParallel (True)
|
||||
KippenParallel (False)
|
||||
|
||||
End Sub
|
||||
@ -1,29 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
|
||||
Public Function Runden(value1 As Double, digits As Integer) As Double
|
||||
|
||||
Dim temp1 As Double
|
||||
|
||||
temp1 = value1 * (10 ^ digits)
|
||||
|
||||
If (temp1 * 10) Mod 10 = 5 Then
|
||||
temp1 = temp1 + 1
|
||||
temp1 = Fix(temp1)
|
||||
temp1 = temp1 / (10 ^ digits)
|
||||
Runden = temp1
|
||||
Else
|
||||
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
|
||||
Public Function Runden(value1 As Double, digits As Integer) As Double
|
||||
|
||||
Dim temp1 As Double
|
||||
|
||||
temp1 = value1 * (10 ^ digits)
|
||||
|
||||
If (temp1 * 10) Mod 10 = 5 Then
|
||||
temp1 = temp1 + 1
|
||||
temp1 = Fix(temp1)
|
||||
temp1 = temp1 / (10 ^ digits)
|
||||
Runden = temp1
|
||||
Else
|
||||
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
|
||||
End If
|
||||
|
||||
End Function
|
||||
@ -1,28 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
|
||||
Public Function Runden(value1 As Double, digits As Integer) As Double
|
||||
|
||||
Dim temp1 As Double
|
||||
|
||||
temp1 = value1 * (10 ^ digits)
|
||||
|
||||
If (temp1 * 10) Mod 10 = 5 Then
|
||||
temp1 = temp1 + 1
|
||||
temp1 = Fix(temp1)
|
||||
temp1 = temp1 / (10 ^ digits)
|
||||
Runden = temp1
|
||||
Else
|
||||
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
|
||||
Public Function Runden(value1 As Double, digits As Integer) As Double
|
||||
|
||||
Dim temp1 As Double
|
||||
|
||||
temp1 = value1 * (10 ^ digits)
|
||||
|
||||
If (temp1 * 10) Mod 10 = 5 Then
|
||||
temp1 = temp1 + 1
|
||||
temp1 = Fix(temp1)
|
||||
temp1 = temp1 / (10 ^ digits)
|
||||
Runden = temp1
|
||||
Else
|
||||
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
|
||||
End If
|
||||
|
||||
End Function
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
|
||||
Public Function Runden(value1 As Double, digits As Integer) As Double
|
||||
|
||||
Dim temp1 As Double
|
||||
|
||||
temp1 = value1 * (10 ^ digits)
|
||||
|
||||
If (temp1 * 10) Mod 10 = 5 Then
|
||||
temp1 = temp1 + 1
|
||||
temp1 = Fix(temp1)
|
||||
temp1 = temp1 / (10 ^ digits)
|
||||
Runden = temp1
|
||||
Else
|
||||
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
|
||||
End If
|
||||
|
||||
End Function
|
||||
@ -1,5 +0,0 @@
|
||||
Private Sub BBehälterlisteDrucken_Click()
|
||||
|
||||
DoCmd.OpenReport "BBehaelter", acViewPreview
|
||||
|
||||
End Sub
|
||||
@ -1,5 +0,0 @@
|
||||
Private Sub BBehälterlisteDrucken_Click()
|
||||
|
||||
DoCmd.OpenReport "BBehaelter", acViewPreview
|
||||
|
||||
End Sub
|
||||
@ -1,4 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
Private Sub Form_Activate()
|
||||
|
||||
filter = "MGNR=" + Format(Forms!FLieferungen!TMGNR)
|
||||
|
||||
FilterOn = True
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
|
||||
Private Sub BEingabe_Click()
|
||||
|
||||
DoCmd.OpenForm "FSortenAttributeEingabe"
|
||||
|
||||
End Sub
|
||||
@ -1 +0,0 @@
|
||||
|
||||
@ -1,3 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,10 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Report_Close()
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarNo
|
||||
End Sub
|
||||
|
||||
Private Sub Report_Open(Cancel As Integer)
|
||||
DoCmd.ShowToolbar "Datenbank", acToolbarYes
|
||||
End Sub
|
||||
@ -1,38 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BAbschlaege"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub TAZAS_Exit(Cancel As Integer)
|
||||
|
||||
If Not IsNull(TAZAS) And Not IsNull(TAZASProzent) Then
|
||||
MsgBox "Es kann pro Zu/Abschlag entweder ein absoluter Wert oder ein Prozentwert angegeben werden, aber nicht beides !", vbCritical
|
||||
TAZAS = ""
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TAZASProzent_Exit(Cancel As Integer)
|
||||
|
||||
If Not IsNull(TAZAS) And Not IsNull(TAZASProzent) Then
|
||||
MsgBox "Es kann pro Zu/Abschlag entweder ein absoluter Wert oder ein Prozentwert angegeben werden, aber nicht beides !", vbCritical
|
||||
TAZASProzent = ""
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@ -1,58 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
'If Not IsNull(GetParameter("LIEFERRECHT/GA1")) Then TLieferrecht1 = CDbl(GetParameter("LIEFERRECHT/GA1"))
|
||||
'If Not IsNull(GetParameter("LIEFERRECHT/GA2")) Then TLieferrecht2 = CDbl(GetParameter("LIEFERRECHT/GA2"))
|
||||
'If Not IsNull(GetParameter("LIEFERPFLICHT/GA1")) Then TLieferpflicht1 = CDbl(GetParameter("LIEFERPFLICHT/GA1"))
|
||||
'If Not IsNull(GetParameter("LIEFERPFLICHT/GA2")) Then TLieferpflicht2 = CDbl(GetParameter("LIEFERPFLICHT/GA2"))
|
||||
|
||||
If Not IsNull(TEurofaktor) Then SetParameter "EUROFAKTOR", TEurofaktor
|
||||
If Not IsNull(TMwSt1) Then SetParameter "MWST1", TMwSt1
|
||||
If Not IsNull(TMwSt2) Then SetParameter "MWST2", TMwSt2
|
||||
If Not IsNull(TMwSt3) Then SetParameter "MWST3", TMwSt3
|
||||
If Not IsNull(TGB) Then SetParameter "GB", TGB
|
||||
If Not IsNull(TRebelabzug) Then SetParameter "REBELABZUG", TRebelabzug
|
||||
|
||||
If Not IsNull(TLieferrecht1) Then SetParameter "LIEFERRECHT/GA1", TLieferrecht1
|
||||
If Not IsNull(TLieferrecht2) Then SetParameter "LIEFERRECHT/GA2", TLieferrecht2
|
||||
If Not IsNull(TLieferpflicht1) Then SetParameter "LIEFERPFLICHT/GA1", TLieferpflicht1
|
||||
If Not IsNull(TLieferpflicht2) Then SetParameter "LIEFERPFLICHT/GA2", TLieferpflicht2
|
||||
|
||||
If Not IsNull(TMAXERTRAG) Then SetParameter "MAXERTRAG", TMAXERTRAG
|
||||
If Not IsNull(TAufschlagVollieferant) Then SetParameter "AUFSCHLAGVOLLLIEFERANT", TAufschlagVollieferant
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
|
||||
If Not IsNull(GetParameter("EUROFAKTOR")) Then TEurofaktor = CDbl(GetParameter("EUROFAKTOR"))
|
||||
If Not IsNull(GetParameter("MWST1")) Then TMwSt1 = CDbl(GetParameter("MWST1"))
|
||||
If Not IsNull(GetParameter("MWST2")) Then TMwSt2 = CDbl(GetParameter("MWST2"))
|
||||
If Not IsNull(GetParameter("MWST3")) Then TMwSt3 = CDbl(GetParameter("MWST3"))
|
||||
|
||||
If Not IsNull(GetParameter("GB")) Then TGB = CDbl(GetParameter("GB"))
|
||||
If Not IsNull(GetParameter("REBELABZUG")) Then TRebelabzug = CDbl(GetParameter("REBELABZUG"))
|
||||
|
||||
If Not IsNull(GetParameter("LIEFERRECHT/GA1")) Then TLieferrecht1 = CDbl(GetParameter("LIEFERRECHT/GA1"))
|
||||
If Not IsNull(GetParameter("LIEFERRECHT/GA2")) Then TLieferrecht2 = CDbl(GetParameter("LIEFERRECHT/GA2"))
|
||||
If Not IsNull(GetParameter("LIEFERPFLICHT/GA1")) Then TLieferpflicht1 = CDbl(GetParameter("LIEFERPFLICHT/GA1"))
|
||||
If Not IsNull(GetParameter("LIEFERPFLICHT/GA2")) Then TLieferpflicht2 = CDbl(GetParameter("LIEFERPFLICHT/GA2"))
|
||||
|
||||
If Not IsNull(GetParameter("MAXERTRAG")) Then TMAXERTRAG = CDbl(GetParameter("MAXERTRAG"))
|
||||
|
||||
If Not IsNull(GetParameter("AUFSCHLAGVOLLLIEFERANT")) Then TAufschlagVollieferant = CDbl(GetParameter("AUFSCHLAGVOLLLIEFERANT"))
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,166 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
|
||||
Private Sub BOk_Click()
|
||||
|
||||
Dim a(0 To 5) As Double
|
||||
Dim g(0 To 5) As Double
|
||||
Dim o(0 To 5) As Double
|
||||
Dim i As Integer
|
||||
|
||||
Dim aznr1 As Long
|
||||
Dim QSNR1 As Long
|
||||
Dim SNR1 As String
|
||||
Dim SANR1 As String
|
||||
Dim start1 As Long
|
||||
Dim gebunden1 As Integer
|
||||
Dim maxreihe As Integer
|
||||
Dim Oechsle1 As Long
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
aznr1 = Forms!FAuszahlung!TAZNR
|
||||
SNR1 = Forms!FAuszahlung!TSNR
|
||||
gebunden1 = Forms!FAuszahlung!TGebunden
|
||||
If IsNull(Forms!FAuszahlung!TSANR) Then
|
||||
SANR1 = "NULL"
|
||||
Else
|
||||
SANR1 = "'" + Forms!FAuszahlung!TSANR + "'"
|
||||
End If
|
||||
|
||||
maxreihe = 0
|
||||
|
||||
If Not IsNull(TO1) Then
|
||||
o(1) = TO1
|
||||
a(1) = TA1
|
||||
g(1) = TG1
|
||||
maxreihe = 1
|
||||
End If
|
||||
|
||||
If Not IsNull(TO2) Then
|
||||
o(2) = TO2
|
||||
a(2) = TA2
|
||||
g(2) = TG2
|
||||
maxreihe = 2
|
||||
End If
|
||||
|
||||
If Not IsNull(TO3) Then
|
||||
o(3) = TO3
|
||||
a(3) = TA3
|
||||
g(3) = TG3
|
||||
maxreihe = 3
|
||||
End If
|
||||
|
||||
If Not IsNull(TO4) Then
|
||||
o(4) = TO4
|
||||
a(4) = TA4
|
||||
g(4) = TG4
|
||||
maxreihe = 4
|
||||
End If
|
||||
|
||||
If Not IsNull(TO5) Then
|
||||
o(5) = TO5
|
||||
a(5) = TA5
|
||||
g(5) = TG5
|
||||
maxreihe = 5
|
||||
End If
|
||||
|
||||
If maxreihe = 0 Then
|
||||
MsgBox "Sie müssen zumindest die Parameter für Reihe 1 eingeben!", vbCritical
|
||||
Exit Sub
|
||||
|
||||
End If
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(aznr1) + " AND SNR='" + Format(SNR1) + "' AND Gebunden=" + Format(gebunden1) + " AND SANR=" + SANR1)
|
||||
|
||||
While Not rs1.EOF
|
||||
|
||||
rs1.Edit
|
||||
|
||||
Oechsle1 = rs1!Oechsle
|
||||
|
||||
i = maxreihe
|
||||
While i > 0 And Oechsle1 < o(i)
|
||||
i = i - 1
|
||||
Wend
|
||||
|
||||
If i > 0 Then
|
||||
rs1!Betrag = g(i) + (Oechsle1 - o(i)) * a(i)
|
||||
Else
|
||||
rs1!Betrag = 0
|
||||
End If
|
||||
|
||||
rs1.Update
|
||||
rs1.MoveNext
|
||||
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
'Parameter sichern
|
||||
If Not IsNull(TO1) Then SetParameter "AuszahlungParameterReihe1OechsleStart", TO1
|
||||
If Not IsNull(TO2) Then SetParameter "AuszahlungParameterReihe2OechsleStart", TO2
|
||||
If Not IsNull(TO3) Then SetParameter "AuszahlungParameterReihe3OechsleStart", TO3
|
||||
If Not IsNull(TO4) Then SetParameter "AuszahlungParameterReihe4OechsleStart", TO4
|
||||
If Not IsNull(TO5) Then SetParameter "AuszahlungParameterReihe5OechsleStart", TO5
|
||||
|
||||
If Not IsNull(TG1) Then SetParameter "AuszahlungParameterReihe1Grundwert", TG1
|
||||
If Not IsNull(TG2) Then SetParameter "AuszahlungParameterReihe2Grundwert", TG2
|
||||
If Not IsNull(TG3) Then SetParameter "AuszahlungParameterReihe3Grundwert", TG3
|
||||
If Not IsNull(TG4) Then SetParameter "AuszahlungParameterReihe4Grundwert", TG4
|
||||
If Not IsNull(TG5) Then SetParameter "AuszahlungParameterReihe5Grundwert", TG5
|
||||
|
||||
If Not IsNull(TA1) Then SetParameter "AuszahlungParameterReihe1Anstieg", TA1
|
||||
If Not IsNull(TA2) Then SetParameter "AuszahlungParameterReihe2Anstieg", TA2
|
||||
If Not IsNull(TA3) Then SetParameter "AuszahlungParameterReihe3Anstieg", TA3
|
||||
If Not IsNull(TA4) Then SetParameter "AuszahlungParameterReihe4Anstieg", TA4
|
||||
If Not IsNull(TA5) Then SetParameter "AuszahlungParameterReihe5Anstieg", TA5
|
||||
|
||||
DoCmd.Close
|
||||
Forms!FAuszahlung!FUnter1.Requery
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
Dim v
|
||||
|
||||
v = GetParameter("AuszahlungParameterReihe1OechsleStart")
|
||||
If Not IsNull(v) Then TO1 = v
|
||||
v = GetParameter("AuszahlungParameterReihe2OechsleStart")
|
||||
If Not IsNull(v) Then TO2 = v
|
||||
v = GetParameter("AuszahlungParameterReihe3OechsleStart")
|
||||
If Not IsNull(v) Then TO3 = v
|
||||
v = GetParameter("AuszahlungParameterReihe4OechsleStart")
|
||||
If Not IsNull(v) Then TO4 = v
|
||||
v = GetParameter("AuszahlungParameterReihe5OechsleStart")
|
||||
If Not IsNull(v) Then TO5 = v
|
||||
|
||||
v = GetParameter("AuszahlungParameterReihe1Grundwert")
|
||||
If Not IsNull(v) Then TG1 = v
|
||||
v = GetParameter("AuszahlungParameterReihe2Grundwert")
|
||||
If Not IsNull(v) Then TG2 = v
|
||||
v = GetParameter("AuszahlungParameterReihe3Grundwert")
|
||||
If Not IsNull(v) Then TG3 = v
|
||||
v = GetParameter("AuszahlungParameterReihe4Grundwert")
|
||||
If Not IsNull(v) Then TG4 = v
|
||||
v = GetParameter("AuszahlungParameterReihe5Grundwert")
|
||||
If Not IsNull(v) Then TG5 = v
|
||||
|
||||
v = GetParameter("AuszahlungParameterReihe1Anstieg")
|
||||
If Not IsNull(v) Then TA1 = v
|
||||
v = GetParameter("AuszahlungParameterReihe2Anstieg")
|
||||
If Not IsNull(v) Then TA2 = v
|
||||
v = GetParameter("AuszahlungParameterReihe3Anstieg")
|
||||
If Not IsNull(v) Then TA3 = v
|
||||
v = GetParameter("AuszahlungParameterReihe4Anstieg")
|
||||
If Not IsNull(v) Then TA4 = v
|
||||
v = GetParameter("AuszahlungParameterReihe5Anstieg")
|
||||
If Not IsNull(v) Then TA5 = v
|
||||
|
||||
|
||||
End Sub
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BBewirtschaftungsarten"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
@ -1,108 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Private Sub Befehl51_Click()
|
||||
|
||||
DoCmd.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BOk_Click()
|
||||
|
||||
Dim aznr1 As Long ' the actual AZNR
|
||||
Dim SNR1 As String ' actual snr
|
||||
Dim SANR1 As String
|
||||
Dim SNR2 As String
|
||||
Dim SANR2 As String
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
Dim i As Long
|
||||
Dim gebunden1 As Integer
|
||||
Dim gebunden2 As Integer
|
||||
Dim varElement As Variant
|
||||
|
||||
|
||||
If MsgBox("Wollen Sie die eingegebene Sortentabelle auf die ausgewählten Sorten kopieren ?", vbYesNo) = vbYes Then
|
||||
|
||||
DoCmd.Hourglass True
|
||||
aznr1 = Forms!FAuszahlung!TAZNR
|
||||
SNR1 = Forms!FAuszahlung!TSNR
|
||||
gebunden1 = Forms!FAuszahlung!TGebunden
|
||||
If IsNull(Forms!FAuszahlung!TSANR) Then
|
||||
SANR1 = ""
|
||||
Else
|
||||
SANR1 = Forms!FAuszahlung!TSANR
|
||||
End If
|
||||
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
|
||||
'For Each varElement In LSorten.ItemsSelected
|
||||
For i = 0 To LSorten.ListCount - 1
|
||||
|
||||
If LSorten.Selected(i) Then
|
||||
|
||||
LSorten.BoundColumn = 1
|
||||
SNR2 = LSorten.ItemData(i)
|
||||
LSorten.BoundColumn = 5
|
||||
If IsNull(LSorten.ItemData(i)) Then
|
||||
SANR2 = ""
|
||||
Else
|
||||
SANR2 = LSorten.ItemData(i)
|
||||
End If
|
||||
LSorten.BoundColumn = 4
|
||||
If LSorten.ItemData(i) = "gebunden" Then
|
||||
gebunden2 = True
|
||||
Else
|
||||
gebunden2 = False
|
||||
End If
|
||||
|
||||
'MsgBox (SNR2)
|
||||
|
||||
If SANR1 = "" Then
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR1 + "' AND Gebunden=" + Format(gebunden1) + " AND SANR IS NULL ORDER BY Oechsle")
|
||||
Else
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR1 + "' AND Gebunden=" + Format(gebunden1) + " AND SANR='" + SANR1 + "' ORDER BY Oechsle")
|
||||
End If
|
||||
If SANR2 = "" Then
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR2 + "' AND Gebunden=" + Format(gebunden2) + " AND SANR IS NULL ORDER BY Oechsle")
|
||||
Else
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM TAuszahlungSorten WHERE AZNR=" + Format(Forms!FAuszahlung!TAZNR) + " AND SNR='" + SNR2 + "' AND Gebunden=" + Format(gebunden2) + " AND SANR='" + SANR2 + "' ORDER BY Oechsle")
|
||||
End If
|
||||
|
||||
While Not rs1.EOF
|
||||
|
||||
|
||||
rs2.Edit
|
||||
rs2!Betrag = rs1!Betrag
|
||||
rs2.Update
|
||||
|
||||
|
||||
rs2.MoveNext
|
||||
rs1.MoveNext
|
||||
|
||||
Wend
|
||||
|
||||
rs1.Close
|
||||
rs2.Close
|
||||
|
||||
End If
|
||||
|
||||
'Next varElement
|
||||
Next i
|
||||
|
||||
DoCmd.Hourglass False
|
||||
|
||||
End If
|
||||
|
||||
DoCmd.Close
|
||||
Forms!FAuszahlung!FUnter1.Requery
|
||||
|
||||
End Sub
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BBewirtschaftungsarten"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BBanken"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BBewirtschaftungsarten"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
@ -1,179 +0,0 @@
|
||||
|
||||
Dim lastCNR
|
||||
|
||||
|
||||
|
||||
Private Sub BJahrWeiter_Click()
|
||||
|
||||
If Not IsNull(TLesejahr) Then
|
||||
TLesejahr = TLesejahr + 1
|
||||
RefreshAll
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BJahrZurueck_Click()
|
||||
|
||||
If Not IsNull(TLesejahr) Then
|
||||
TLesejahr = TLesejahr - 1
|
||||
RefreshAll
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BUmfuellen_Click()
|
||||
|
||||
Dim CNR1 As Long
|
||||
|
||||
Select Case XUmfuellenOption
|
||||
|
||||
Case 1: 'vorhandene
|
||||
|
||||
ChargeUmfuellen Forms("MChargenAuswahl")!LChargen, LChargen, TMenge, OMengeZuruecksetzen, OOechsleZuruecksetzen, OStatusEntleert
|
||||
|
||||
Case 2: 'neue
|
||||
CNR1 = ChargeClonen(Forms("MChargenAuswahl")!LChargen, TBNR, 0, 0)
|
||||
ChargeUmfuellen Forms("MChargenAuswahl")!LChargen, CNR1, TMenge, OMengeZuruecksetzen, OOechsleZuruecksetzen, OStatusEntleert
|
||||
|
||||
End Select
|
||||
|
||||
DoCmd.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Activate()
|
||||
|
||||
RefreshAll
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
OMengeZuruecksetzen = True
|
||||
OOechsleZuruecksetzen = True
|
||||
OStatusEntleert = True
|
||||
|
||||
If Month(Date) < 9 Then
|
||||
TLesejahr = year(Date) - 1
|
||||
Else
|
||||
TLesejahr = year(Date)
|
||||
End If
|
||||
|
||||
lastCNR = -1
|
||||
|
||||
TMenge = DFirst("Menge", "TChargen", "CNR=Forms!MChargenAuswahl!LChargen")
|
||||
|
||||
|
||||
|
||||
XUmfuellenOption = 1
|
||||
|
||||
RefreshAll
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LChargen_DblClick(Cancel As Integer)
|
||||
|
||||
lastCNR = LChargen
|
||||
|
||||
ChargeUmfuellen Forms("MChargenAuswahl")!LChargen, LChargen, TMenge, OMengeZuruecksetzen, OOechsleZuruecksetzen, OStatusEntleert
|
||||
DoCmd.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TLesejahr_Exit(Cancel As Integer)
|
||||
|
||||
RefreshAll
|
||||
|
||||
End Sub
|
||||
|
||||
Function GetFilter() As String
|
||||
|
||||
Dim filter1
|
||||
|
||||
filter1 = "Jahrgang=" + Format(TLesejahr)
|
||||
|
||||
filter1 = filter1 + " AND TChargen.CSNR=2"
|
||||
filter1 = filter1 + " AND TChargen.CNR<>" + Format(Forms("MChargenAuswahl")!LChargen)
|
||||
|
||||
If Not IsNull(TZNR) Then
|
||||
filter1 = filter1 + " AND TChargen.ZNR=" + TZNR
|
||||
End If
|
||||
|
||||
GetFilter = filter1
|
||||
|
||||
End Function
|
||||
|
||||
Function GetOrder() As String
|
||||
|
||||
GetOrder = " ORDER BY BefuellungsBeginn"
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Sub RefreshAll()
|
||||
|
||||
Dim filter1
|
||||
Dim query1
|
||||
|
||||
'query1 = "SELECT TLieferungen.CNR, TLieferungen.Lieferscheinnummer AS Lieferscheinnr, TLieferungen.Datum, Format(TLieferungen.Uhrzeit,'HH:MM') as Zeit, TMitglieder.MGNR, [Nachname]+' '+IIf(IsNull([Vorname]),'',[Vorname]) AS Mitglied, TSorten.Bezeichnung AS Sorte, TLieferungen.Gewicht, TLieferungen.Oechsle, IIf(Storniert=True,'STORNIERT',Left(TLieferungen.Anmerkung,20)) AS Info FROM TSorten INNER JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TSorten.SNR = TLieferungen.SNR"
|
||||
query1 = "SELECT TChargen.CNR, TChargen.Chargennummer as ChNr, TChargen.Befuellungsbeginn as BefStart, TChargen.Befuellungsende as BefEnde, TChargen.BehaelterEntleertAm as Entleerg, TChargenStatus.ChargenStatus as Status, TChargen.SNR, TChargen.SANR, TQualitaetsstufen.Bezeichnung as Qualitaet, TChargen.Menge,TBehaelter.Kurzbezeichnung as Behaelter, TZweigstellen.Name as Zweigstelle FROM ((TZweigstellen RIGHT JOIN (TChargen LEFT JOIN TChargenStatus ON TChargen.CSNR = TChargenStatus.CSNR) ON TZweigstellen.ZNR = TChargen.ZNR) LEFT JOIN TBehaelter ON TChargen.BNR = TBehaelter.BNR) LEFT JOIN TQualitaetsstufen ON TChargen.QSNRVon = TQualitaetsstufen.QSNR"
|
||||
filter1 = GetFilter
|
||||
query1 = query1 + " WHERE " + filter1 + GetOrder
|
||||
'MsgBox (query1)
|
||||
LChargen.RowSource = query1
|
||||
LChargen.Requery
|
||||
|
||||
'LChargen.SetFocus
|
||||
|
||||
If lastCNR = -1 And LChargen.ListCount > 0 Then
|
||||
'MsgBox (LChargen.ItemData(1))
|
||||
LChargen = LChargen.ItemData(1)
|
||||
End If
|
||||
|
||||
If lastCNR >= 0 Then
|
||||
LChargen = lastCNR
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TSortierung_Change()
|
||||
|
||||
RefreshAll
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TZNR_Change()
|
||||
|
||||
RefreshAll
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub XUmfuellenOption_Click()
|
||||
|
||||
Select Case XUmfuellenOption
|
||||
|
||||
Case 1: 'vorhandene
|
||||
LChargen.Visible = True
|
||||
TLesejahr.Visible = True
|
||||
TZNR.Visible = True
|
||||
BJahrZurueck.Visible = True
|
||||
BJahrWeiter.Visible = True
|
||||
TBNR.Visible = False
|
||||
LBehaelter.Visible = False
|
||||
|
||||
Case 2: 'neue
|
||||
TBNR.Visible = True
|
||||
LChargen.Visible = False
|
||||
TLesejahr.Visible = False
|
||||
TZNR.Visible = False
|
||||
BJahrZurueck.Visible = False
|
||||
BJahrWeiter.Visible = False
|
||||
LBehaelter.Visible = True
|
||||
|
||||
|
||||
End Select
|
||||
|
||||
End Sub
|
||||
@ -1,70 +0,0 @@
|
||||
Private Sub BBefüllungBeenden_Click()
|
||||
|
||||
ChargeBefuellungBeenden (TCNR)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BBefüllungStarten_Click()
|
||||
|
||||
ChargeBefuellungStarten (TCNR)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BChargenstammblatt_Click()
|
||||
|
||||
DoCmd.OpenReport "BChargenStammblatt", acViewPreview, , "CNR=" + Format(TCNR)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BUmfuellen_Click()
|
||||
|
||||
DoCmd.OpenForm "FChargeUmfuellen"
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Current()
|
||||
|
||||
LLieferungen.Requery
|
||||
LChargenVorgaenger.Requery
|
||||
LChargenNachfolger.Requery
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LChargenNachfolger_DblClick(Cancel As Integer)
|
||||
|
||||
filter = "CNR=" + Format(LChargenNachfolger)
|
||||
FilterOn = True
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LChargenVorgaenger_DblClick(Cancel As Integer)
|
||||
|
||||
filter = "CNR=" + Format(LChargenVorgaenger)
|
||||
FilterOn = True
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBNR_Exit(Cancel As Integer)
|
||||
|
||||
RefreshChargennummer
|
||||
|
||||
End Sub
|
||||
|
||||
Sub RefreshChargennummer()
|
||||
|
||||
Dim Maxcounter1 As Long
|
||||
'MsgBox (TChargennummer)
|
||||
If IsNull(TChargennummer) And TBNR > 0 Then
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
TChargennummer = GeneriereChargennummer(TCNR, Maxcounter1)
|
||||
TChargennummerZaehler = Maxcounter1
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TChargennummer_Exit(Cancel As Integer)
|
||||
|
||||
RefreshChargennummer
|
||||
|
||||
End Sub
|
||||
@ -1,24 +0,0 @@
|
||||
Private Sub BNeuerNied_Click()
|
||||
|
||||
If IsNull(LGNR) Then
|
||||
MsgBox "Bitte zuerst Gemeinde auswählen !", vbCritical
|
||||
Else
|
||||
DoCmd.OpenForm ("FRiedeMitglied")
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LRiede_GotFocus()
|
||||
query1 = "SELECT RNR, BEZEICHNUNG FROM TRiede WHERE GNR=" + Format(LGNR) + " order by BEZEICHNUNG "
|
||||
LRiede.RowSource = query1
|
||||
LRiede.Requery
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LRiede_LostFocus()
|
||||
query1 = "SELECT RNR, BEZEICHNUNG FROM TRiede order by BEZEICHNUNG;"
|
||||
LRiede.RowSource = query1
|
||||
LRiede.Requery
|
||||
|
||||
End Sub
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBezeichnung_Exit(Cancel As Integer)
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Sub RefreshMain()
|
||||
|
||||
Dim gebietsnr As Long
|
||||
|
||||
gebietsnr = CLng(Forms!FGebiete!TWBGNR)
|
||||
|
||||
Forms!FGebietshierarchie.InitGebiete
|
||||
Forms!FGebietshierarchie!LGebiete = gebietsnr
|
||||
Forms!FGebietshierarchie.InitGrosslagen
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,345 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub BGebietBearbeiten_Click()
|
||||
|
||||
DoCmd.OpenForm "FGebiete", acNormal, , "WBGNR=" + Format(LGebiete.Value), acFormEdit
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGebietLoeschen_Click()
|
||||
|
||||
If MsgBox("Sind Sie sicher, daß Sie dieses Gebiet löschen wollen ?", vbYesNo) = vbYes Then
|
||||
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TGebiete WHERE WBGNR=" + Format(Forms!FGebietshierarchie!LGebiete) + ";")
|
||||
|
||||
rs1.MoveFirst
|
||||
rs1.Delete
|
||||
rs1.Close
|
||||
|
||||
LGebiete.SetFocus
|
||||
InitGebiete
|
||||
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGebietNeu_Click()
|
||||
|
||||
DoCmd.OpenForm "FGebiete", acNormal, , "RNR=" + Format(LRegionen.Value), acFormAdd
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGemeindeBearbeiten_Click()
|
||||
|
||||
DoCmd.OpenForm "FGemeinden", acNormal, , "GNR=" + Format(LGemeinden.Value), acFormEdit
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGemeindeLoeschen_Click()
|
||||
|
||||
If MsgBox("Sind Sie sicher, daß Sie diese Gemeinde löschen wollen ?", vbYesNo) = vbYes Then
|
||||
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TGemeinden WHERE GNR=" + Format(Forms!FGebietshierarchie!LGemeinden) + ";")
|
||||
|
||||
rs1.MoveFirst
|
||||
rs1.Delete
|
||||
rs1.Close
|
||||
|
||||
LGemeinden.SetFocus
|
||||
InitGemeinden
|
||||
|
||||
End If
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGemeindeNeu_Click()
|
||||
|
||||
DoCmd.OpenForm "FGemeinden", acNormal, , "GLNR=" + Format(LGrosslagen.Value), acFormAdd
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGrosslageBearbeiten_Click()
|
||||
|
||||
DoCmd.OpenForm "FGrosslagen", acNormal, , "GLNR=" + Format(LGrosslagen.Value), acFormEdit
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGrosslageLoeschen_Click()
|
||||
|
||||
If MsgBox("Sind Sie sicher, daß Sie diese Großlage löschen wollen ?", vbYesNo) = vbYes Then
|
||||
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TGrosslagen WHERE GLNR=" + Format(Forms!FGebietshierarchie!LGrosslagen) + ";")
|
||||
|
||||
rs1.MoveFirst
|
||||
rs1.Delete
|
||||
rs1.Close
|
||||
|
||||
LGrosslagen.SetFocus
|
||||
InitGrosslagen
|
||||
|
||||
|
||||
End If
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BGrosslageNeu_Click()
|
||||
|
||||
DoCmd.OpenForm "FGrosslagen", acNormal, , "WBGNR=" + Format(LGebiete.Value), acFormAdd
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BRegionBearbeiten_Click()
|
||||
|
||||
DoCmd.OpenForm "FRegionen", acNormal, , "RGNR=" + Format(LRegionen.Value), acFormEdit
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BRegionLoeschen_Click()
|
||||
|
||||
If MsgBox("Sind Sie sicher, daß Sie diese Region löschen wollen ?", vbYesNo) = vbYes Then
|
||||
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TRegionen WHERE RGNR=" + Format(Forms!FGebietshierarchie!LRegionen) + ";")
|
||||
|
||||
rs1.MoveFirst
|
||||
rs1.Delete
|
||||
rs1.Close
|
||||
|
||||
LRegionen.SetFocus
|
||||
InitRegionen
|
||||
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BRegionNeu_Click()
|
||||
|
||||
DoCmd.OpenForm "FRegionen", acNormal, , , acFormAdd
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BRiedBearbeiten_Click()
|
||||
|
||||
DoCmd.OpenForm "FRiede", acNormal, , "RNR=" + Format(LRiede.Value), acFormEdit
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BRiedLoeschen_Click()
|
||||
|
||||
If MsgBox("Sind Sie sicher, daß Sie diesen Ried löschen wollen ?", vbYesNo) = vbYes Then
|
||||
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TRiede WHERE RNR=" + Format(Forms!FGebietshierarchie!LRiede) + ";")
|
||||
|
||||
rs1.MoveFirst
|
||||
rs1.Delete
|
||||
rs1.Close
|
||||
|
||||
LRiede.SetFocus
|
||||
InitRiede
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BRiedNeu_Click()
|
||||
|
||||
DoCmd.OpenForm "FRiede", acNormal, , "GNR=" + Format(LGemeinden.Value), acFormAdd
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
InitRegionen
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitRegionen()
|
||||
|
||||
'LRegionen.SetFocus
|
||||
BRegionNeu.Visible = True
|
||||
BRegionLoeschen.Visible = True
|
||||
BRegionBearbeiten.Visible = True
|
||||
|
||||
LRegionen.Requery
|
||||
If LRegionen.ListCount > 0 Then
|
||||
LRegionen = LRegionen.ItemData(0)
|
||||
BGebietNeu.Visible = True
|
||||
BRegionLoeschen.Visible = True
|
||||
BRegionBearbeiten.Visible = True
|
||||
Else
|
||||
LRegionen = -1
|
||||
BRegionLoeschen.Visible = False
|
||||
BRegionBearbeiten.Visible = False
|
||||
BGebietNeu.Visible = False
|
||||
BGebietBearbeiten.Visible = False
|
||||
BGebietLoeschen.Visible = False
|
||||
End If
|
||||
|
||||
InitGebiete
|
||||
|
||||
End Sub
|
||||
|
||||
Sub InitGebiete()
|
||||
|
||||
|
||||
LGebiete.Requery
|
||||
'LGebiete.SetFocus
|
||||
If LGebiete.ListCount > 0 Then
|
||||
LGebiete = LGebiete.ItemData(0)
|
||||
BGebietBearbeiten.Visible = True
|
||||
BGebietLoeschen.Visible = True
|
||||
BGrosslageNeu.Visible = True
|
||||
Else
|
||||
LGebiete = -1
|
||||
BGebietLoeschen.Visible = False
|
||||
BGebietBearbeiten.Visible = False
|
||||
BGrosslageNeu.Visible = False
|
||||
BGrosslageLoeschen.Visible = False
|
||||
BGrosslageBearbeiten.Visible = False
|
||||
End If
|
||||
|
||||
InitGrosslagen
|
||||
|
||||
End Sub
|
||||
|
||||
Sub InitGrosslagen()
|
||||
|
||||
LGrosslagen.Requery
|
||||
'LGrosslagen.SetFocus
|
||||
If LGrosslagen.ListCount > 0 Then
|
||||
LGrosslagen = LGrosslagen.ItemData(0)
|
||||
BGrosslageLoeschen.Visible = True
|
||||
BGrosslageBearbeiten.Visible = True
|
||||
BGemeindeNeu.Visible = True
|
||||
Else
|
||||
LGrosslagen = -1
|
||||
BGrosslageLoeschen.Visible = False
|
||||
BGrosslageBearbeiten.Visible = False
|
||||
BGemeindeNeu.Visible = False
|
||||
BGemeindeLoeschen.Visible = False
|
||||
BGemeindeBearbeiten.Visible = False
|
||||
End If
|
||||
|
||||
InitGemeinden
|
||||
|
||||
End Sub
|
||||
|
||||
Sub InitGemeinden()
|
||||
|
||||
'LGemeinden.SetFocus
|
||||
LGemeinden.Requery
|
||||
|
||||
If LGemeinden.ListCount > 0 Then
|
||||
LGemeinden = LGemeinden.ItemData(0)
|
||||
BGemeindeLoeschen.Visible = True
|
||||
BGemeindeBearbeiten.Visible = True
|
||||
BRiedNeu.Visible = True
|
||||
Else
|
||||
LGemeinden = -1
|
||||
BGemeindeLoeschen.Visible = False
|
||||
BGemeindeBearbeiten.Visible = False
|
||||
BRiedNeu.Visible = False
|
||||
BRiedLoeschen.Visible = False
|
||||
BRiedBearbeiten.Visible = False
|
||||
End If
|
||||
|
||||
InitRiede
|
||||
|
||||
End Sub
|
||||
|
||||
Sub InitRiede()
|
||||
|
||||
LRiede.Requery
|
||||
'LRiede.SetFocus
|
||||
|
||||
If LRiede.ListCount > 0 Then
|
||||
LRiede = LRiede.ItemData(0)
|
||||
BRiedLoeschen.Visible = True
|
||||
BRiedBearbeiten.Visible = True
|
||||
Else
|
||||
LRiede = -1
|
||||
BRiedLoeschen.Visible = False
|
||||
BRiedBearbeiten.Visible = False
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LGebiete_Click()
|
||||
|
||||
InitGrosslagen
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LGemeinden_Click()
|
||||
|
||||
InitRiede
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LGrosslagen_Click()
|
||||
|
||||
InitGemeinden
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LRegionen_Click()
|
||||
|
||||
InitGebiete
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl34_Click()
|
||||
On Error GoTo Err_Befehl34_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BGebietshierarchie"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl34_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl34_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl34_Click
|
||||
|
||||
End Sub
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBezeichnung_Exit(Cancel As Integer)
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Sub RefreshMain()
|
||||
|
||||
Dim GNR As Long
|
||||
|
||||
GNR = CLng(Forms!FGemeinden!TGNR)
|
||||
|
||||
Forms!FGebietshierarchie.InitGemeinden
|
||||
Forms!FGebietshierarchie!LGemeinden = GNR
|
||||
Forms!FGebietshierarchie.InitRiede
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBezeichnung_Exit(Cancel As Integer)
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Sub RefreshMain()
|
||||
|
||||
Dim GLNR As Long
|
||||
|
||||
GLNR = CLng(Forms!FGrosslagen!TGLNR)
|
||||
|
||||
Forms!FGebietshierarchie.InitGrosslagen
|
||||
Forms!FGebietshierarchie!LGrosslagen = GLNR
|
||||
Forms!FGebietshierarchie.InitGemeinden
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,52 +0,0 @@
|
||||
Public Lesejahr As Integer
|
||||
|
||||
|
||||
Public Function GetLesejahr()
|
||||
|
||||
GetLesejahr = Lesejahr
|
||||
|
||||
End Function
|
||||
|
||||
Public Sub SetLesejahr(Jahr1 As Integer)
|
||||
Lesejahr = Jahr1
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BLeseplanungDrucken_Click()
|
||||
|
||||
|
||||
DoCmd.OpenReport "BLeseplanung", acPreview, , "Year(Datum)=" + Format(Lesejahr)
|
||||
|
||||
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
|
||||
|
||||
|
||||
End Sub
|
||||
@ -1,69 +0,0 @@
|
||||
|
||||
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
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BAbschlaege"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
@ -1,718 +0,0 @@
|
||||
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
|
||||
@ -1,61 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Kombinationsfeld39_Change()
|
||||
|
||||
TBlz = TBank
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
If Not IsNull(TName1) Then SetParameter "MANDANTENNAME1", TName1
|
||||
If Not IsNull(TName2) Then SetParameter "MANDANTENNAME2", TName2
|
||||
If Not IsNull(TStrasse) Then SetParameter "MANDANTENSTRASSE", TStrasse
|
||||
If Not IsNull(TPLZ) Then SetParameter "MANDANTENPLZ", TPLZ
|
||||
If Not IsNull(TOrt) Then SetParameter "MANDANTENORT", TOrt
|
||||
If Not IsNull(TTelefon) Then SetParameter "MANDANTENTELEFON", TTelefon
|
||||
If Not IsNull(TTelefax) Then SetParameter "MANDANTENTELEFAX", TTelefax
|
||||
If Not IsNull(TDvr) Then SetParameter "MANDANTENDVR", TDvr
|
||||
If Not IsNull(TBetriebsnummer) Then SetParameter "MANDANTENBETRIEBSNUMMER", TBetriebsnummer
|
||||
If Not IsNull(TBlz) Then SetParameter "MANDANTENBLZ", TBlz
|
||||
If Not IsNull(TKontonummer) Then SetParameter "MANDANTENKONTONUMMER", TKontonummer
|
||||
If Not IsNull(TUID) Then SetParameter "MANDANTENUID", TUID
|
||||
If Not IsNull(TEMail) Then SetParameter "MANDANTENEMAIL", TEMail
|
||||
If Not IsNull(THomepage) Then SetParameter "MANDANTENHOMEPAGE", THomepage
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
|
||||
If Not IsNull(GetParameter("MANDANTENNAME1")) Then TName1 = GetParameter("MANDANTENNAME1")
|
||||
If Not IsNull(GetParameter("MANDANTENNAME2")) Then TName2 = GetParameter("MANDANTENNAME2")
|
||||
If Not IsNull(GetParameter("MANDANTENSTRASSE")) Then TStrasse = GetParameter("MANDANTENSTRASSE")
|
||||
If Not IsNull(GetParameter("MANDANTENPLZ")) Then TPLZ = GetParameter("MANDANTENPLZ")
|
||||
If Not IsNull(GetParameter("MANDANTENORT")) Then TOrt = GetParameter("MANDANTENORT")
|
||||
If Not IsNull(GetParameter("MANDANTENTELEFON")) Then TTelefon = GetParameter("MANDANTENTELEFON")
|
||||
If Not IsNull(GetParameter("MANDANTENTELEFAX")) Then TTelefax = GetParameter("MANDANTENTELEFAX")
|
||||
If Not IsNull(GetParameter("MANDANTENDVR")) Then TDvr = GetParameter("MANDANTENDVR")
|
||||
If Not IsNull(GetParameter("MANDANTENBETRIEBSNUMMER")) Then TBetriebsnummer = GetParameter("MANDANTENBETRIEBSNUMMER")
|
||||
If Not IsNull(GetParameter("MANDANTENBLZ")) Then TBlz = GetParameter("MANDANTENBLZ")
|
||||
If Not IsNull(GetParameter("MANDANTENBLZ")) Then TBank = GetParameter("MANDANTENBLZ")
|
||||
If Not IsNull(GetParameter("MANDANTENKONTONUMMER")) Then TKontonummer = GetParameter("MANDANTENKONTONUMMER")
|
||||
If Not IsNull(GetParameter("MANDANTENUID")) Then TUID = GetParameter("MANDANTENUID")
|
||||
If Not IsNull(GetParameter("MANDANTENEMAIL")) Then TEMail = GetParameter("MANDANTENEMAIL")
|
||||
If Not IsNull(GetParameter("MANDANTENHOMEPAGE")) Then THomepage = GetParameter("MANDANTENHOMEPAGE")
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBank_Change()
|
||||
|
||||
TBlz = TBank
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBlz_Exit(Cancel As Integer)
|
||||
|
||||
TBank = TBlz
|
||||
|
||||
End Sub
|
||||
@ -1,288 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Dim select1 As String
|
||||
Dim where1 As String
|
||||
Dim order1 As String
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Private Sub Befehl81_Click()
|
||||
|
||||
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
DoCmd.OpenForm "MMitgliederliste"
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Befehl86_Click()
|
||||
|
||||
order1 = " ORDER BY MGNR;"
|
||||
RequeryListe
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Befehl87_Click()
|
||||
|
||||
order1 = " ORDER BY Nachname,Vorname;"
|
||||
RequeryListe
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BLöschen_Click()
|
||||
|
||||
If MsgBox("Wollen Sie dieses Mitglied wirklich löschen ?", vbYesNo) = vbYes Then
|
||||
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
|
||||
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
|
||||
LMitglieder.Requery
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BNeu_Click()
|
||||
|
||||
Dim str1 As String
|
||||
Dim mgnr1 As Long
|
||||
|
||||
str1 = InputBox("Bitte geben Sie den Familiennamen des Mitglieds ein:")
|
||||
If str1 <> "" Then
|
||||
DoCmd.GoToRecord , , acNewRec
|
||||
TNachname.SetFocus
|
||||
TNachname = str1
|
||||
TMGNR.SetFocus
|
||||
mgnr1 = TMGNR
|
||||
TVorname.SetFocus
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
'DoCmd.GoToRecord , , acPrevious
|
||||
LMitglieder.Requery
|
||||
LMitglieder = mgnr1
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BSuchen_Click()
|
||||
|
||||
Dim suchstring
|
||||
Dim rs1 As Recordset
|
||||
Dim db1 As Database
|
||||
Dim where2 As String
|
||||
|
||||
suchstring = InputBox("Geben Sie bitte den Suchbegriff ein: ")
|
||||
|
||||
If IsNull(suchstring) Or suchstring = "" Then
|
||||
where1 = ""
|
||||
Else
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TMitglieder")
|
||||
|
||||
If OAlleMitglieder = False Then
|
||||
where1 = " WHERE [Aktives Mitglied]=True AND MGNR IN (-1,"
|
||||
Else
|
||||
where1 = " WHERE MGNR IN (-1,"
|
||||
End If
|
||||
|
||||
suchstring = UCase(suchstring)
|
||||
|
||||
While Not rs1.EOF
|
||||
If InStr(UCase(rs1!Nachname), suchstring) > 0 Or InStr(UCase(rs1!Vorname), suchstring) > 0 Or InStr(UCase(rs1!Ort), suchstring) > 0 Or InStr(UCase(Format(rs1!MGNR)), suchstring) > 0 Then
|
||||
where1 = where1 + Format(rs1!MGNR) + ","
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
where1 = Left(where1, Len(where1) - 1) + ")"
|
||||
|
||||
End If
|
||||
'MsgBox (where1)
|
||||
|
||||
RequeryListe
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
LMitglieder = TMGNR
|
||||
OAlleMitglieder = False
|
||||
select1 = "SELECT TMitglieder.MGNR, [Nachname]+IIf(IsNull([Vorname]),'',' '+[Vorname]) AS Name1, MGNR FROM TMitglieder "
|
||||
where1 = " WHERE [Aktives Mitglied]=true "
|
||||
order1 = " ORDER BY Nachname,Vorname;"
|
||||
LMitglieder.SetFocus
|
||||
LMitglieder.Value = LMitglieder.ItemData(0)
|
||||
TMGNR.SetFocus
|
||||
DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True
|
||||
'DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LMitglieder_Click()
|
||||
|
||||
'Filter = "MGNR=Forms!FMitglieder.LMitglieder"
|
||||
'FilterOn = True
|
||||
|
||||
TMGNR.SetFocus
|
||||
DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True
|
||||
LMitglieder.SetFocus
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub OAlleMitglieder_Click()
|
||||
|
||||
If OAlleMitglieder = False Then
|
||||
where1 = " WHERE [Aktives Mitglied]=True "
|
||||
Else
|
||||
where1 = ""
|
||||
End If
|
||||
|
||||
RequeryListe
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Private Sub Text70_Exit(Cancel As Integer)
|
||||
|
||||
If Text70.Value <> "" Then
|
||||
If MsgBox("Ist das Mitglied noch aktiv ?", vbYesNo) = vbYes Then
|
||||
KAM.Value = 1
|
||||
Else
|
||||
KAM.Value = 0
|
||||
End If
|
||||
End If
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl80_Click()
|
||||
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
|
||||
SetParameter "STAMMBLATTTEXT", " "
|
||||
DoCmd.OpenReport "BMitgliedStammblattMGNR", acViewPreview, , "TMitglieder.MGNR=" + Format(TMGNR)
|
||||
|
||||
If GetParameter("LIEFERMENGENDRUCKEN") = "1" Then
|
||||
|
||||
If DSum("Flaeche", "TFlaechenbindungen", "MGNR=" + Format(TMGNR) + " AND (Bis>=Year(Date()) OR Bis IS NULL)") > 0 Then
|
||||
DoCmd.OpenReport "BLiefermenge", acViewPreview, , "TMitglieder.MGNR=" + Format(TMGNR)
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'DoCmd.OpenForm "MStammblatt"
|
||||
'Forms!MStammblatt!TVon1 = TMGNR
|
||||
'Forms!MStammblatt!TBis1 = TMGNR
|
||||
'DoCmd.OpenReport "BMitgliedStammblatt", acViewPreview
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TMGNR_DblClick(Cancel As Integer)
|
||||
|
||||
Dim mgnr1 As Long
|
||||
|
||||
mgnr1 = InputBox("Nach welcher Mitgliedsnummer soll gesucht werden ?", "Mitgliedssuche nach MGNR")
|
||||
|
||||
LMitglieder = mgnr1
|
||||
|
||||
TMGNR.SetFocus
|
||||
DoCmd.FindRecord Forms!FMitglieder!LMitglieder, acEntire, , , , acCurrent, True
|
||||
LMitglieder.SetFocus
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TMGNR_Exit(Cancel As Integer)
|
||||
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TMGNRV_Exit(Cancel As Integer)
|
||||
|
||||
Dim Jahr1 As Long
|
||||
Dim mgnr1 As Long
|
||||
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
|
||||
If Not IsNull(TMGNRV) And TMGNRV <> 0 Then
|
||||
If DCount("FBNR", "TFlaechenbindungen", "MGNR=" + Format(TMGNRV)) > 0 Then
|
||||
If MsgBox("Wollen Sie bestehende Flächenbindungen des Vorgängers übernehmen ?", vbYesNo) = vbYes Then
|
||||
Jahr1 = 0
|
||||
While Jahr1 < 1900 Or Jahr1 > 2500
|
||||
Jahr1 = InputBox("Übergabejahr:")
|
||||
Wend
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset 'old member
|
||||
Dim rs2 As Recordset 'new member
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen WHERE MGNR=" + Format(TMGNRV))
|
||||
Set rs2 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen WHERE MGNR=" + Format(TMGNR))
|
||||
While Not rs1.EOF
|
||||
' new record
|
||||
rs2.AddNew
|
||||
rs2!MGNR = TMGNR
|
||||
rs2!GNR = rs1!GNR
|
||||
rs2!RNR = rs1!RNR
|
||||
rs2!SNR = rs1!SNR
|
||||
rs2!SANR = rs1!SANR
|
||||
rs2!Parzellennummer = rs1!Parzellennummer
|
||||
rs2!Flaeche = rs1!Flaeche
|
||||
rs2!BANR = rs1!BANR
|
||||
rs2!Von = Jahr1
|
||||
rs2!Bis = rs1!Bis
|
||||
rs2!FBNR = DMax("[FBNR]", "TFlaechenbindungen") + 1
|
||||
rs2.Update
|
||||
' change old record: Bis
|
||||
rs1.Edit
|
||||
rs1!Bis = Jahr1 - 1
|
||||
rs1.Update
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
rs2.Close
|
||||
mgnr1 = TMGNR
|
||||
FUnter.Requery
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TNachname_Exit(Cancel As Integer)
|
||||
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
LMitglieder.Requery
|
||||
LMitglieder = TMGNR
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RequeryListe()
|
||||
|
||||
Dim mgnr1 As Long
|
||||
|
||||
mgnr1 = TMGNR
|
||||
LMitglieder.RowSource = select1 + where1 + order1
|
||||
LMitglieder.Requery
|
||||
LMitglieder = mgnr1
|
||||
LMitglieder.SetFocus
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TVorname_Exit(Cancel As Integer)
|
||||
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
LMitglieder.Requery
|
||||
LMitglieder = TMGNR
|
||||
|
||||
End Sub
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl48_Click()
|
||||
On Error GoTo Err_Befehl48_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BQualitätsstufen"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl48_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl48_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl48_Click
|
||||
|
||||
End Sub
|
||||
@ -1,27 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBezeichnung_Exit(Cancel As Integer)
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Sub RefreshMain()
|
||||
|
||||
Dim Regionsnr As Long
|
||||
|
||||
Regionsnr = CLng(Forms!FRegionen!TRGNR)
|
||||
|
||||
Forms!FGebietshierarchie.InitRegionen
|
||||
Forms!FGebietshierarchie!LRegionen = Regionsnr
|
||||
Forms!FGebietshierarchie.InitGebiete
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,26 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub TBezeichnung_Exit(Cancel As Integer)
|
||||
|
||||
RefreshMain
|
||||
|
||||
End Sub
|
||||
|
||||
Sub RefreshMain()
|
||||
|
||||
Dim RNR As Long
|
||||
|
||||
RNR = CLng(Forms!FRiede!TRNR)
|
||||
|
||||
Forms!FGebietshierarchie.InitRiede
|
||||
Forms!FGebietshierarchie!LRiede = RNR
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1,42 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
AddNewRied
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
LGNR = Forms!FMitglieder!FUnter.Form![LGNR]
|
||||
If DCount("RNR", "TRiede", "") = 0 Then
|
||||
TRNR = 1
|
||||
Else
|
||||
TRNR = DMax("RNR", "TRiede", "") + 1
|
||||
End If
|
||||
TWGBZS = 0
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddNewRied()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
If Not IsNull(TBezeichnung) Then
|
||||
|
||||
Set db1 = CurrentDb
|
||||
Set rs1 = db1.OpenRecordset("TRiede")
|
||||
rs1.AddNew
|
||||
rs1!RNR = TRNR
|
||||
rs1!GNR = LGNR
|
||||
rs1!Bezeichnung = TBezeichnung
|
||||
rs1!RZS = TWGBZS
|
||||
rs1.Update
|
||||
[Forms]![FMitglieder]![FUnter].[Form]![LRiede] = TRNR
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
@ -1,25 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl46_Click()
|
||||
On Error GoTo Err_Befehl46_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BSorten"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl46_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl46_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl46_Click
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub BSortenKuerzelUmbenennen_Click()
|
||||
|
||||
DoCmd.OpenForm "FSortenkuerzelUmbenennen"
|
||||
|
||||
End Sub
|
||||
@ -1,129 +0,0 @@
|
||||
Private Sub BUmbenennen_Click()
|
||||
|
||||
DoCmd.Hourglass True
|
||||
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
|
||||
SortenKuerzelUmbenennen
|
||||
DoCmd.Hourglass False
|
||||
DoCmd.Close
|
||||
Forms!FSorten.Requery
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
TempTabelleAnlegen
|
||||
|
||||
Forms!FSortenkuerzelUmbenennen.RecordSource = "xTempSortenkuerzelumbenennen"
|
||||
Requery
|
||||
|
||||
End Sub
|
||||
|
||||
Sub TempTabelleAnlegen()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
If TableExists("xTempSortenkuerzelUmbenennen") Then
|
||||
db1.Execute ("drop table xTempSortenkuerzelUmbenennen")
|
||||
End If
|
||||
db1.Execute ("Create table xTempSortenkuerzelUmbenennen (SNRAlt TEXT, BezeichnungAlt TEXT, kgprohaalt DOUBLE,typalt TEXT, SNRNeu TEXT, BezeichnungNeu TEXT, kgprohaneu DOUBLE, typneu TEXT)")
|
||||
db1.Execute ("delete * from xTempSortenkuerzelumbenennen")
|
||||
Set rs1 = db1.OpenRecordset("SELECT * FROM TSorten")
|
||||
Set rs2 = db1.OpenRecordset("xTempSortenkuerzelumbenennen")
|
||||
While Not rs1.EOF
|
||||
rs2.AddNew
|
||||
rs2!SNRAlt = rs1!SNR
|
||||
rs2!SNRNeu = rs1!SNR
|
||||
rs2!BezeichnungAlt = rs1!Bezeichnung
|
||||
rs2!Bezeichnungneu = rs1!Bezeichnung
|
||||
rs2!kgprohaneu = rs1!KgProHa
|
||||
rs2!kgprohaalt = rs1!KgProHa
|
||||
rs2!Typalt = rs1!Typ
|
||||
rs2!Typneu = rs1!Typ
|
||||
|
||||
rs2.Update
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
rs2.Close
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SortenKuerzelUmbenennen()
|
||||
|
||||
Dim db1 As Database
|
||||
Dim rs1 As Recordset
|
||||
Dim rs2 As Recordset
|
||||
|
||||
Set db1 = CurrentDb
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT * from xTempSortenkuerzelUmbenennen ORDER BY SNRAlt")
|
||||
|
||||
'1. Alle Sorten von alt auf neu mit n als Präfix
|
||||
While Not rs1.EOF
|
||||
|
||||
'TAuszahlungSorten
|
||||
db1.Execute ("UPDATE TAuszahlungSorten SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'")
|
||||
'TFlaechenbindungen
|
||||
db1.Execute ("UPDATE TFlaechenbindungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'")
|
||||
'TLieferungen
|
||||
db1.Execute ("UPDATE TLieferungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'")
|
||||
'TSorten
|
||||
db1.Execute ("UPDATE TSorten SET SNR='n" + rs1!SNRNeu + "',kgproha=" + Format(rs1!kgprohaneu) + " WHERE SNR='" + Format(rs1!SNRAlt) + "'")
|
||||
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
'2. Bei allen Sorten den Präfix n entfernen
|
||||
|
||||
Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNRNeu from xTempSortenkuerzelUmbenennen ORDER BY SNRNeu")
|
||||
db1.Execute ("DELETE * FROM TSorten")
|
||||
Set rs2 = db1.OpenRecordset("TSorten")
|
||||
|
||||
While Not rs1.EOF
|
||||
|
||||
'TAuszahlungSorten
|
||||
db1.Execute ("UPDATE TAuszahlungSorten SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'")
|
||||
'TFlaechenbindungen
|
||||
db1.Execute ("UPDATE TFlaechenbindungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'")
|
||||
'TLieferungen
|
||||
db1.Execute ("UPDATE TLieferungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'")
|
||||
'TSorten
|
||||
' db1.Execute ("UPDATE TSorten SET SNR='" + rs1!SNRneu + "' WHERE SNR='n" + rs1!SNRneu + "'")
|
||||
rs2.AddNew
|
||||
rs2!SNR = rs1!SNRNeu
|
||||
rs2!KgProHa = DFirst("kgprohaneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'")
|
||||
rs2!Bezeichnung = DFirst("Bezeichnungneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'")
|
||||
rs2!Typ = DFirst("typneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'")
|
||||
rs2.Update
|
||||
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Function TableExists(table1) As Boolean
|
||||
|
||||
Dim db1 As Database
|
||||
Set db1 = CurrentDb
|
||||
Dim x As TableDef
|
||||
|
||||
For Each x In db1.TableDefs
|
||||
If x.Name = table1 Then
|
||||
TableExists = True
|
||||
Exit Function
|
||||
End If
|
||||
Next x
|
||||
|
||||
TableExists = False
|
||||
|
||||
End Function
|
||||
@ -1,36 +0,0 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
If Not IsNull(TAuszahlungtext) Then SetParameter "AUSZAHLUNGTEXT", TAuszahlungtext
|
||||
If Not IsNull(TLieferscheintext) Then SetParameter "LIEFERSCHEINTEXT", TLieferscheintext
|
||||
If Not IsNull(TAnlieferungsbestätigung) Then SetParameter "ANLIEFTEXT", TAnlieferungsbestätigung
|
||||
If Not IsNull(TAuszahlungzusatz_PA) Then SetParameter "AUSZAHLUNGZUSATZTEXT_PA", TAuszahlungzusatz_PA
|
||||
If Not IsNull(TAuszahlungzusatz_BF) Then SetParameter "AUSZAHLUNGZUSATZTEXT_BF", TAuszahlungzusatz_BF
|
||||
If Not IsNull(TAbsendertext1) Then SetParameter "ABSENDERTEXT1", TAbsendertext1
|
||||
If Not IsNull(TAbsendertext2) Then SetParameter "ABSENDERTEXT2", TAbsendertext2
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
If Not IsNull(GetParameter("AUSZAHLUNGTEXT")) Then TAuszahlungtext = GetParameter("AUSZAHLUNGTEXT")
|
||||
If Not IsNull(GetParameter("LIEFERSCHEINTEXT")) Then TLieferscheintext = GetParameter("LIEFERSCHEINTEXT")
|
||||
If Not IsNull(GetParameter("ANLIEFTEXT")) Then TAnlieferungsbestätigung = GetParameter("ANLIEFTEXT")
|
||||
If Not IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_BF")) Then TAuszahlungzusatz_BF = GetParameter("AUSZAHLUNGZUSATZTEXT_BF")
|
||||
If Not IsNull(GetParameter("AUSZAHLUNGZUSATZTEXT_PA")) Then TAuszahlungzusatz_PA = GetParameter("AUSZAHLUNGZUSATZTEXT_PA")
|
||||
If Not IsNull(GetParameter("ABSENDERTEXT1")) Then TAbsendertext1 = GetParameter("ABSENDERTEXT1")
|
||||
If Not IsNull(GetParameter("ABSENDERTEXT2")) Then TAbsendertext2 = GetParameter("ABSENDERTEXT2")
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,18 +0,0 @@
|
||||
|
||||
|
||||
Private Sub BAuswaehlen_Click()
|
||||
|
||||
If LChargen > 0 Then
|
||||
Forms("FÜbernahme")!TCNR = LChargen
|
||||
End If
|
||||
|
||||
DoCmd.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LChargen_DblClick(Cancel As Integer)
|
||||
|
||||
Forms("FÜbernahme")!TCNR = LChargen
|
||||
DoCmd.Close
|
||||
|
||||
End Sub
|
||||
@ -1,19 +0,0 @@
|
||||
Private Sub LGNR_Exit(Cancel As Integer)
|
||||
|
||||
End Sub
|
||||
Private Sub Befehl48_Click()
|
||||
On Error GoTo Err_Befehl48_Click
|
||||
|
||||
Dim stDocName As String
|
||||
|
||||
stDocName = "BUmrechnung"
|
||||
DoCmd.OpenReport stDocName, acViewPreview
|
||||
|
||||
Exit_Befehl48_Click:
|
||||
Exit Sub
|
||||
|
||||
Err_Befehl48_Click:
|
||||
MsgBox Err.Description
|
||||
Resume Exit_Befehl48_Click
|
||||
|
||||
End Sub
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user