GESTION DE PACKS

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