Guten Tag
Ich wäre sehr dankbar, wenn mir jemand diesen Code erkären könnte, da ich leider kein vb verstehe.
Der Code funktioniert auch leider nicht mehr, da es aus einer sehr alten AccessDB ist. Ich möchte diese Berechnung nun ohne VB in einer Excel Tabelle speichern. Das Resultat der Berechnung sollte folgendes ergeben:
Nach eingabe der Läng und Breite und der Qualität (W...) berechnet die Formel den Preis des Gehäuses:
Function Preise_Chassis_W0 ()
'
' Mit dieser Funktion wird der Preis eines Gehäuses/Chassis Typ W errechnet.
'
'
Dim Typ As String
Dim Länge As Integer
Dim Breite As Integer
Dim grösse2 As Integer
Dim Preis2 As Single
Static Grösse(60) As Integer
Static Preis(60) As Single
Dim Grösse_Array As Integer ' Grösse Array
Dim i As Integer
Dim x As Integer
Dim y As Single
Grösse_Array = 48
Grösse(1) = 65
Grösse(2) = 70
Grösse(3) = 75
Grösse(4) = 80
Grösse(5) = 85
Grösse(6) = 90
Grösse(7) = 95
Grösse(8) = 100
Grösse(9) = 105
Grösse(10) = 110
Grösse(11) = 115
Grösse(12) = 120
Grösse(13) = 125
Grösse(14) = 130
Grösse(15) = 135
Grösse(16) = 140
Grösse(17) = 145
Grösse(18) = 150
Grösse(19) = 155
Grösse(20) = 160
Grösse(21) = 165
Grösse(22) = 170
Grösse(23) = 175
Grösse(24) = 180
Grösse(25) = 185
Grösse(26) = 190
Grösse(27) = 195
Grösse(28) = 200
Grösse(29) = 205
Grösse(30) = 210
Grösse(31) = 215
Grösse(32) = 220
Grösse(33) = 225
Grösse(34) = 230
Grösse(35) = 235
Grösse(36) = 240
Grösse(37) = 245
Grösse(38) = 250
Grösse(39) = 255
Grösse(40) = 260
Grösse(41) = 265
Grösse(42) = 270
Grösse(43) = 275
Grösse(44) = 280
Grösse(45) = 285
Grösse(46) = 290
Grösse(47) = 295
Grösse(48) = 300
Preis(1) = 17.5
Preis(2) = 18.5
Preis(3) = 19.5
Preis(4) = 20.5
Preis(5) = 21.5
Preis(6) = 22.5
Preis(7) = 23.5
Preis(8) = 25
Preis(9) = 27.5
Preis(10) = 30
Preis(11) = 34
Preis(12) = 38
Preis(13) = 42
Preis(14) = 46
Preis(15) = 48
Preis(16) = 50
Preis(17) = 52
Preis(18) = 55
Preis(19) = 57.5
Preis(20) = 60
Preis(21) = 65
Preis(22) = 70
Preis(23) = 73
Preis(24) = 76
Preis(25) = 78
Preis(26) = 80
Preis(27) = 83
Preis(28) = 86
Preis(29) = 89
Preis(30) = 92
Preis(31) = 95
Preis(32) = 98
Preis(33) = 101
Preis(34) = 104
Preis(35) = 107
Preis(36) = 110
Preis(37) = 114
Preis(38) = 118
Preis(39) = 122
Preis(40) = 128
Preis(41) = 131
Preis(42) = 132
Preis(43) = 140
Preis(44) = 145
Preis(45) = 150
Preis(46) = 155
Preis(47) = 160
Preis(48) = 165
If IsNull(Forms![Chassis W0]![Breite]) Or Forms![Chassis W0]![Breite] <> Int(Forms![Chassis W0]![Breite]) Then
Beep
x = MsgBox("Bitte nur ganze Zahlen eingeben", 48, "Eingabeprüfung")
DoCmd CancelEvent
DoCmd GoToControl "[Breite]"
Exit Function
Else
End If
Typ = Forms![Chassis W0]![Typ]
Länge = Forms![Chassis W0]![Länge]
Breite = Forms![Chassis W0]![Breite]
grösse2 = Länge + Breite
If grösse2 > Grösse(Grösse_Array) Then ' ab 300 cm kosten jede weitere 5cm 8.--
y = grösse2 - Grösse(Grösse_Array)
y = y / 5
If y <> Int(y) Then y = y + 1
y = Int(y)
Preis2 = Preis(Grösse_Array) + (y * 8)
Else
i = Grösse_Array
Do Until grösse2 > Grösse(i)
i = i - 1
Loop
Preis2 = Preis(i + 1)
End If
If Typ = "W0" Then
ElseIf Typ = "W1" Then
Preis2 = Preis2 * 1.1
ElseIf Typ = "W2" Then
Preis2 = Preis2 * 1.2
ElseIf Typ = "W3" Then
Preis2 = Preis2 * 1.3
ElseIf Typ = "W4" Then
Preis2 = Preis2 * 1.4
ElseIf Typ = "W5" Then
Preis2 = Preis2 * 1.5
ElseIf Typ = "W6" Then
Preis2 = Preis2 * 1.6
ElseIf Typ = "W7" Then
Preis2 = Preis2 * 1.7
ElseIf Typ = "W8" Then
Preis2 = Preis2 * 1.8
ElseIf Typ = "W9" Then
Preis2 = Preis2 * 1.9
ElseIf Typ = "W10" Then
Preis2 = Preis2 * 2
ElseIf Typ = "W11" Then
Preis2 = Preis2 * 2.1
ElseIf Typ = "W12" Then
Preis2 = Preis2 * 2.2
ElseIf Typ = "W13" Then
Preis2 = Preis2 * 2.3
ElseIf Typ = "W14" Then
Preis2 = Preis2 * 2.4
ElseIf Typ = "W15" Then
Preis2 = Preis2 * 2.5
ElseIf Typ = "W16" Then
Preis2 = Preis2 * 2.6
ElseIf Typ = "W17" Then
Preis2 = Preis2 * 2.7
ElseIf Typ = "W18" Then
Preis2 = Preis2 * 2.8
ElseIf Typ = "W19" Then
Preis2 = Preis2 * 2.9
ElseIf Typ = "W20" Then
Preis2 = Preis2 * 3
ElseIf Typ = "W21" Then
Preis2 = Preis2 * 3.1
ElseIf Typ = "W22" Then
Preis2 = Preis2 * 3.2
ElseIf Typ = "W23" Then
Preis2 = Preis2 * 3.3
End If
If grösse2 > 190 Then
Forms![Bestellung erfassen]![Bestellpositionen erfassen].Form![Zusatz_Chassis_W] = "Chassis verstrebt " & Typ & Str(Länge) & " x" & Str(Breite) & " cm"
Else
Forms![Bestellung erfassen]![Bestellpositionen erfassen].Form![Zusatz_Chassis_W] = "Chassis " & Typ & Str(Länge) & " x" & Str(Breite) & " cm"
End If
Forms![Bestellung erfassen]![Bestellpositionen erfassen].Form![Bestellpositionen.Preis] = Preis2
DoCmd Close
End Function
|