Gestion de pack
Résolu
communicrat
Messages postés
5
Date d'inscription
mercredi 16 avril 2003
Statut
Membre
Dernière intervention
5 août 2004
-
3 août 2004 à 10:43
communicrat Messages postés 5 Date d'inscription mercredi 16 avril 2003 Statut Membre Dernière intervention 5 août 2004 - 5 août 2004 à 11:08
communicrat Messages postés 5 Date d'inscription mercredi 16 avril 2003 Statut Membre Dernière intervention 5 août 2004 - 5 août 2004 à 11:08
3 réponses
communicrat
Messages postés
5
Date d'inscription
mercredi 16 avril 2003
Statut
Membre
Dernière intervention
5 août 2004
5 août 2004 à 11:08
5 août 2004 à 11:08
voici le code que j'ai pondu...
je vais le mettre en source si ca interresse quelqu'un...
Option Compare Database
Option Explicit
Public Sub Delete(ByRef tableau As Variant, element As Variant)
Dim r As Integer
Dim t As Integer
For r = element To UBound(tableau, 2) - 1
tableau(0, r) = tableau(0, r + 1)
tableau(1, r) = tableau(1, r + 1)
Next
ReDim Preserve tableau(0 To 1, 0 To UBound(tableau, 2) - 1)
End Sub
Function MiseAJourPack()
Dim TableDevis As DAO.Recordset
Dim TableDetailDevis As DAO.Recordset
Dim TablePackProduit As DAO.Recordset
Dim TablePack As DAO.Recordset
Dim TableProduit As DAO.Recordset
'selection du numero de devis
Dim SqlDevis As String
SqlDevis = "SELECT Max(TableDevis.N°Devis) AS Numdevis FROM TableDevis"
Set TableDevis = CurrentDb.OpenRecordset(SqlDevis)
Dim NumDevis As Integer
NumDevis = TableDevis.Fields.Item(0).Value
'########## tableau detaildevis ##########
Dim SqlDetailDevis As StringSqlDetailDevis "SELECT TableDétailDevis.N°ProduitDétailDevis, TableDétailDevis.NombreProduitDétailDevis FROM TableDevis INNER JOIN TableDétailDevis ON TableDevis.N°Devis TableDétailDevis.N°DevisDétailDevis WHERE (((TableDétailDevis.N°DevisDétailDevis) = " & NumDevis & ")) ORDER BY TableDétailDevis.N°ProduitDétailDevis"
Set TableDetailDevis = CurrentDb.OpenRecordset(SqlDetailDevis)
Dim TableauDetailDevis() As Integer
Dim CompteurTableDetailDevis As Integer
Dim i As Integer
CompteurTableDetailDevis = TableDetailDevis.RecordCount
'creation
While TableDetailDevis.EOF = False
ReDim Preserve TableauDetailDevis(0 To 1, 0 To i)
TableauDetailDevis(0, i) = TableDetailDevis.Fields.Item(0).Value
TableauDetailDevis(1, i) = TableDetailDevis.Fields.Item(1).Value
i = i + 1
TableDetailDevis.MoveNext
Wend
'regroupement
i = 0
Dim j As Integer
j = CompteurTableDetailDevis - 1
While i < j
If TableauDetailDevis(0, i) = TableauDetailDevis(0, i + 1) Then
TableauDetailDevis(1, i) = TableauDetailDevis(1, i) + TableauDetailDevis(1, i + 1)
Delete TableauDetailDevis, (i + 1) 'permet d'enlever les lignes redondantes
i = i - 1
j = j - 1
End If
i = i + 1
Wend
'########## tableau detailpacks ##########
Dim SqlPack As String
SqlPack = "SELECT TablePack.N°Pack FROM TablePack ORDER BY TablePack.PrixPack DESC"
Set TablePack = CurrentDb.OpenRecordset(SqlPack)
Dim NombrePack As Integer
NombrePack = TablePack.RecordCount
Dim SqlDetailpack As String
Dim NumPack As Integer
Dim NombreProduitsPack As Integer
Dim k As Integer
Dim TableauPack() As Integer
Dim p As Integer
Dim NbPtCommuns As Integer
Dim y As Integer
Dim test1 As Integer
Dim test2 As Integer
Dim TableauDevisCorrigé() As Integer
Dim oui As Boolean
Do While TablePack.EOF = False
NumPack = TablePack.Fields.Item(0).Value SqlDetailpack "SELECT TablePackProduit.N°ProduitPackProduit, TablePackProduit.NombrePackProduit FROM TablePack INNER JOIN TablePackProduit ON TablePack.N°Pack TablePackProduit.N°PackPackProduit WHERE (((TablePack.N°Pack)=" & NumPack & ")) ORDER BY TablePackProduit.N°ProduitPackProduit"
Set TablePackProduit = CurrentDb.OpenRecordset(SqlDetailpack)
NombreProduitsPack = TablePackProduit.RecordCount
ReDim TableauPack(0 To 1, 0 To 0)
k = 0
'creation
While TablePackProduit.EOF = False
ReDim Preserve TableauPack(0 To 1, 0 To k)
TableauPack(0, k) = TablePackProduit.Fields.Item(0).Value
TableauPack(1, k) = TablePackProduit.Fields.Item(1).Value
k = k + 1
TablePackProduit.MoveNext
Wend
'comparaison avec tableau devis
While p < i + 1
test1 = TableauDetailDevis(0, p)
test2 = TableauDetailDevis(1, p)
ReDim Preserve TableauDevisCorrigé(0 To 1, 0 To p)
oui = False
For y = 0 To k
If (test1 = TableauPack(0, p) And test2 >= TableauPack(1, p)) Then
oui = True
NbPtCommuns = NbPtCommuns + 1
If test2 > TableauPack(1, p) Then
TableauDevisCorrigé(0, p) = test1
TableauDevisCorrigé(1, p) = test2 - TableauPack(1, p)
Exit For
End If
End If
y = y + 1
Next y
If oui = False Then 'si la ligne ne fait pas partie du pack, on ne la corrige pas.
TableauDevisCorrigé(0, p) = test1
TableauDevisCorrigé(1, p) = test2
End If
p = p + 1
Wend
If NbPtCommuns = k Then 'si il y a autant de lignes corrigées que dans le pack, on rajoute le pack
ReDim Preserve TableauDevisCorrigé(0 To 1, 0 To p)
TableauDevisCorrigé(0, p) = NumPack
TableauDevisCorrigé(1, p) = 1
Exit Do
End If
'essai avec un autre pack
TablePack.MoveNext
Loop
' le tableau devis corrigé prends en compte les packs
End Function
je vais le mettre en source si ca interresse quelqu'un...
Option Compare Database
Option Explicit
Public Sub Delete(ByRef tableau As Variant, element As Variant)
Dim r As Integer
Dim t As Integer
For r = element To UBound(tableau, 2) - 1
tableau(0, r) = tableau(0, r + 1)
tableau(1, r) = tableau(1, r + 1)
Next
ReDim Preserve tableau(0 To 1, 0 To UBound(tableau, 2) - 1)
End Sub
Function MiseAJourPack()
Dim TableDevis As DAO.Recordset
Dim TableDetailDevis As DAO.Recordset
Dim TablePackProduit As DAO.Recordset
Dim TablePack As DAO.Recordset
Dim TableProduit As DAO.Recordset
'selection du numero de devis
Dim SqlDevis As String
SqlDevis = "SELECT Max(TableDevis.N°Devis) AS Numdevis FROM TableDevis"
Set TableDevis = CurrentDb.OpenRecordset(SqlDevis)
Dim NumDevis As Integer
NumDevis = TableDevis.Fields.Item(0).Value
'########## tableau detaildevis ##########
Dim SqlDetailDevis As StringSqlDetailDevis "SELECT TableDétailDevis.N°ProduitDétailDevis, TableDétailDevis.NombreProduitDétailDevis FROM TableDevis INNER JOIN TableDétailDevis ON TableDevis.N°Devis TableDétailDevis.N°DevisDétailDevis WHERE (((TableDétailDevis.N°DevisDétailDevis) = " & NumDevis & ")) ORDER BY TableDétailDevis.N°ProduitDétailDevis"
Set TableDetailDevis = CurrentDb.OpenRecordset(SqlDetailDevis)
Dim TableauDetailDevis() As Integer
Dim CompteurTableDetailDevis As Integer
Dim i As Integer
CompteurTableDetailDevis = TableDetailDevis.RecordCount
'creation
While TableDetailDevis.EOF = False
ReDim Preserve TableauDetailDevis(0 To 1, 0 To i)
TableauDetailDevis(0, i) = TableDetailDevis.Fields.Item(0).Value
TableauDetailDevis(1, i) = TableDetailDevis.Fields.Item(1).Value
i = i + 1
TableDetailDevis.MoveNext
Wend
'regroupement
i = 0
Dim j As Integer
j = CompteurTableDetailDevis - 1
While i < j
If TableauDetailDevis(0, i) = TableauDetailDevis(0, i + 1) Then
TableauDetailDevis(1, i) = TableauDetailDevis(1, i) + TableauDetailDevis(1, i + 1)
Delete TableauDetailDevis, (i + 1) 'permet d'enlever les lignes redondantes
i = i - 1
j = j - 1
End If
i = i + 1
Wend
'########## tableau detailpacks ##########
Dim SqlPack As String
SqlPack = "SELECT TablePack.N°Pack FROM TablePack ORDER BY TablePack.PrixPack DESC"
Set TablePack = CurrentDb.OpenRecordset(SqlPack)
Dim NombrePack As Integer
NombrePack = TablePack.RecordCount
Dim SqlDetailpack As String
Dim NumPack As Integer
Dim NombreProduitsPack As Integer
Dim k As Integer
Dim TableauPack() As Integer
Dim p As Integer
Dim NbPtCommuns As Integer
Dim y As Integer
Dim test1 As Integer
Dim test2 As Integer
Dim TableauDevisCorrigé() As Integer
Dim oui As Boolean
Do While TablePack.EOF = False
NumPack = TablePack.Fields.Item(0).Value SqlDetailpack "SELECT TablePackProduit.N°ProduitPackProduit, TablePackProduit.NombrePackProduit FROM TablePack INNER JOIN TablePackProduit ON TablePack.N°Pack TablePackProduit.N°PackPackProduit WHERE (((TablePack.N°Pack)=" & NumPack & ")) ORDER BY TablePackProduit.N°ProduitPackProduit"
Set TablePackProduit = CurrentDb.OpenRecordset(SqlDetailpack)
NombreProduitsPack = TablePackProduit.RecordCount
ReDim TableauPack(0 To 1, 0 To 0)
k = 0
'creation
While TablePackProduit.EOF = False
ReDim Preserve TableauPack(0 To 1, 0 To k)
TableauPack(0, k) = TablePackProduit.Fields.Item(0).Value
TableauPack(1, k) = TablePackProduit.Fields.Item(1).Value
k = k + 1
TablePackProduit.MoveNext
Wend
'comparaison avec tableau devis
While p < i + 1
test1 = TableauDetailDevis(0, p)
test2 = TableauDetailDevis(1, p)
ReDim Preserve TableauDevisCorrigé(0 To 1, 0 To p)
oui = False
For y = 0 To k
If (test1 = TableauPack(0, p) And test2 >= TableauPack(1, p)) Then
oui = True
NbPtCommuns = NbPtCommuns + 1
If test2 > TableauPack(1, p) Then
TableauDevisCorrigé(0, p) = test1
TableauDevisCorrigé(1, p) = test2 - TableauPack(1, p)
Exit For
End If
End If
y = y + 1
Next y
If oui = False Then 'si la ligne ne fait pas partie du pack, on ne la corrige pas.
TableauDevisCorrigé(0, p) = test1
TableauDevisCorrigé(1, p) = test2
End If
p = p + 1
Wend
If NbPtCommuns = k Then 'si il y a autant de lignes corrigées que dans le pack, on rajoute le pack
ReDim Preserve TableauDevisCorrigé(0 To 1, 0 To p)
TableauDevisCorrigé(0, p) = NumPack
TableauDevisCorrigé(1, p) = 1
Exit Do
End If
'essai avec un autre pack
TablePack.MoveNext
Loop
' le tableau devis corrigé prends en compte les packs
End Function
crenaud76
Messages postés
4172
Date d'inscription
mercredi 30 juillet 2003
Statut
Membre
Dernière intervention
9 juin 2006
28
3 août 2004 à 10:50
3 août 2004 à 10:50
Faire une procédure qui va lire le devis et son contenu et ensuite voir si les quantités produit par produit corresponde (sont > ou =) a celle d'un pack !! Dans ce cas, tu pourras soustraire les qté correspondante au pack des qté du devis et éventuellement recommencé la même procédure, au cas ou un autre pack (ou le même une seconde fois) ferait l'affaire.
Une jolie petite proc de comparaison. Un peu long à coder mais rien de bien compliquer. Pour la faire : Fait toi-même le raisonnement sur papier, en notant chaque fois que tu fais de tête une comparaison et une soustraction de qté par produit.
Il te restera à retranscrire cela en code.
Christophe R.
Une jolie petite proc de comparaison. Un peu long à coder mais rien de bien compliquer. Pour la faire : Fait toi-même le raisonnement sur papier, en notant chaque fois que tu fais de tête une comparaison et une soustraction de qté par produit.
Il te restera à retranscrire cela en code.
Christophe R.
communicrat
Messages postés
5
Date d'inscription
mercredi 16 avril 2003
Statut
Membre
Dernière intervention
5 août 2004
3 août 2004 à 10:59
3 août 2004 à 10:59
salut et merci de ta réponse...
mais en fait c'est ce que j'essaye de faire depuis 2 jours....
et j'y arrive pas.... :sad)
Mais bon je vais arreter et reprendre demain à tete reposée.... ca me permettra de voir peut-etre un peu plus clair...
par contre si quelqu'un a déjà fait ça qu'il n'hésite pas ;)
mais en fait c'est ce que j'essaye de faire depuis 2 jours....
et j'y arrive pas.... :sad)
Mais bon je vais arreter et reprendre demain à tete reposée.... ca me permettra de voir peut-etre un peu plus clair...
par contre si quelqu'un a déjà fait ça qu'il n'hésite pas ;)