Soit une base destinée à faire des devis. Soit :
une table produits (vis, clous,...)
une table pack (promo du jour, promo du mois ...)
une table pack-produits (promo du jour=5vis+3clous, promo du mois= 20vis+30clous...)
une table devis et
une table detail devis.
Mon probleme est que j'ai un commercial pas malin :D qui oublie tout le temps les packs promo. Donc quanq dans le devis il rentre 20vis+30clous, le logiciel lui répond un prix erroné. Pas content le client :(!.
C'est très schématisé mais le principe est le bon.
comment à partir de ma table devis (celle ou je rentre les références et le nombre d'articles) est-ce qu'il pourrait me retrouver (et corriger tout seul) le nom et le nombre de pack à partir de mes tables pack et pack-produits (sans etre obligé de retoucher ma prog à chaque promo que je fais...).
Par exemple : 21vis+33clous deviendrait 1 promo du mois+1vis+3clous...
la solution est là...
Le code ci dessous n'est peut-etre pas très pur, mais ca marche.
si il peut aider quelqu'un....
Source / Exemple :
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 String
SqlDetailDevis = "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
Conclusion :
je suis entrain de faire une base access pour faire des devis...(en cours de test)
qd elle sera finie, je la mettrai en ligne.
Ca y est elle est en ligne sur
http://communicrat.free.fr/base.zip
merci de me faire passer vos corrections éventuelles. (communicrat@free.fr)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.