Files
elwig-misc/wgmaster/vba/MTanksanlegen.bas
2022-11-14 23:29:49 +01:00

408 lines
7.9 KiB
QBasic

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