1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
| Private Sub Calculer_Click()
Me.Recordset.MoveFirst
Dim b(0 To 4) As Integer ' taille des barres
Dim m(0 To 200, 0 To 2) As Double ' taille et nb des morceaux
Dim r As Integer
Dim i As Integer
Dim j As Integer
Dim t As Boolean
Dim tot As Integer
Dim l As String
Dim LO As Integer
' Initialisation des tableaux de longueur disponible
b(0) = [LONG]
b(1) = [Long2]
b(2) = [Long3]
b(3) = [Long4]
b(4) = [Long5]
For LO = 1 To 200
m(LO, 0) = [Longueur]
m(LO, 1) = [Quantitee]
m(LO, 2) = [Item]
Lecture des données
Me.Recordset.MoveNext
If Me.Recordset.EOF Then
Me.Recordset.MovePrevious
GoTo BOUCLE
End If
Next
' Boucle de calcul
BOUCLE:
Dim lngindex As Long
Dim lngTmp As Long
DoCmd.OpenForm ("frmProgressBar")
For lngindex = 4 To 10000000
ProgressBar lngindex, 10000000, lngTmp
Next
DoCmd.Close acForm, "frmProgressBar"
Do
t = False
r = b(0)
l = ""
tot = 0
'Vérifie si la longueur est plus grande que celle disponible
If m(LO, 0) > r Then
r = b(1)
End If
If m(LO, 0) > r Then
r = b(2)
End If
If m(LO, 0) > r Then
r = b(3)
End If
If m(LO, 0) > r Then
r = b(4)
End If
For j = LBound(m, 1) To UBound(m, 1)
If m(j, 1) > 0 Then ' si le nb de morceaux est > 0
t = True ' Pour continuer la boucle s'il reste des morceaux à couper
For i = m(j, 1) To 1 Step -1
If m(j, 0) * i <= r Then
m(j, 1) = m(j, 1) - i
' Construction de la ligne pour affichage
If l = "" Then
l = "(" & i & " fois " & m(j, 0) & ")"
Else
l = l & " + " & "(" & i & " fois " & m(j, 0) & ")"
End If
' Totalisation de la longueur des morceaux
tot = tot + m(j, 0) * i
' Calcul du reste de longueur de la barre
r = r - m(j, 0) * i
Exit For
End If
Next
End If
Next
' Affichage des résultats dans la zone de liste list1
Dim z As String
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Resultat")
If t Then List1.AddItem " " & l & " = " & tot & " - Chute " & b(0) - tot
z = l & " = " & tot & " - Chute " & b(0) - tot
Enregistrement dans la table resultat
With rs
rs.AddNew ' Add new record
!Calcul = z ' Set fields
!PRODUIT = Me.PRODUIT
rs.Update ' Save changes.
rs.Bookmark = rs.LastModified ' Go to new record
End With
rs.Close
Loop While t
End Sub |
Partager