XL 2013 somme quantité sur tableau

RomainPOIRET

XLDnaute Occasionnel
Bonjour à tous,

Je me casse la tête avec une macro depuis 1 semaine ...
Je vous explique le contexte :

j'ai un onglet "commande" qui ressence les articles que je souhaite commander,
j'ai un onglet "Booking" qui me sert à rentrer les articles que je viens de recevoir,

Le problème se trouve dans le userform affichable avec le bouton de l'onglet "booking",
dans la macro je demande la chose suivante :
- si le numéro de commande et l'article du userform correspondent à une entrée déjà inscrite dans le tableau alors j'additionne la valeur à l'existant,
- sinon je rajoute une ligne avec la quantité demandée ,

le problème vient des boucles du userform je pense ...

En espérant que vous trouverez la solution ...

Bien à vous,

Romain
 

Pièces jointes

  • GESTION_CONSOMMABLES(test).xlsm
    771.9 KB · Affichages: 6
Solution
Bonjour à toutes & à tous, bonjour @RomainPOIRET, @cp4
J'ai décroché un long moment hier (PC allumé), mais je te réponds aujourd'hui.

Juste une question qui me turlupine :
Quand il t'arrive une commande incomplète avec une facture, n'as-tu pas une deuxième facture quand le solde te parvient ?​

Pourquoi as-tu la première ligne de tes tableaux structurés vide?
@cp4 je ne sais pas ... :/
C'était sans doute à cause du listrows.add lors du premier enregistrement (la ligne 1 n'est pas entièrement vide puisqu'il y a des formules, il faut tester le nombre de valeurs contenues dans cette ligne pour savoir s'il faut en ajouter une ou utiliser celle-là)

Dans un premier temps j'ai nommé tes tableaux structurés (...

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toutes & à tous, bonjour @RomainPOIRET, @cp4
J'ai décroché un long moment hier (PC allumé), mais je te réponds aujourd'hui.

Juste une question qui me turlupine :
Quand il t'arrive une commande incomplète avec une facture, n'as-tu pas une deuxième facture quand le solde te parvient ?​

Pourquoi as-tu la première ligne de tes tableaux structurés vide?
@cp4 je ne sais pas ... :/
C'était sans doute à cause du listrows.add lors du premier enregistrement (la ligne 1 n'est pas entièrement vide puisqu'il y a des formules, il faut tester le nombre de valeurs contenues dans cette ligne pour savoir s'il faut en ajouter une ou utiliser celle-là)

Dans un premier temps j'ai nommé tes tableaux structurés ( _Tb_Articles, _Tb_Commandes, _Tb_Booking, _Tb_Fournisseurs, _Tb_Personnel).

Dans le code j'ai mis en référence "Microsoft Scripting Runtime" pour avoir accès aux dictionnaires :
1649772195854.png

J'ai repris le code du formulaire Ajout_Booking (j'ai aussi inversé deux combobox et nommé les boutons de commande) :
Enrichi (BBcode):
Option Explicit
Public memoire As Integer
Dim DicoArt As New Scripting.Dictionary
Dim DicoFour As New Scripting.Dictionary
Dim DicoQté As New Scripting.Dictionary
Dim DicoCom As New Scripting.Dictionary
Dim DicoBook As New Scripting.Dictionary
Enrichi (BBcode):
Private Sub UserForm_Initialize()
    Dim tbC, tbB, i%
    DicoArt.CompareMode = TextCompare
    DicoFour.CompareMode = TextCompare
    DicoQté.CompareMode = TextCompare
    DicoCom.CompareMode = TextCompare
    DicoBook.CompareMode = TextCompare
    tbC = [_Tb_Commandes].Value
    tbB = [_Tb_Booking].Value
    For i = 1 To UBound(tbC)
        DicoArt(tbC(i, 1)) = IIf(DicoArt.Exists(tbC(i, 1)), DicoArt(tbC(i, 1)) & Chr(10), "") & tbC(i, 3)
        DicoQté(tbC(i, 1) & tbC(i, 3)) = DicoQté(tbC(i, 1) & tbC(i, 3)) + tbC(i, 6)
        DicoFour(tbC(i, 1) & tbC(i, 3)) = tbC(i, 9)
        DicoCom(tbC(i, 1) & tbC(i, 3)) = WorksheetFunction.Index(tbC, i, 0)
    Next i
    For i = 1 To UBound(tbB)
        DicoBook(tbB(i, 3) & tbB(i, 5)) = i
    Next i
    If DicoBook.Exists("") Then DicoBook.Remove ("")
    Me.Label_info.Caption = Sheets("Configuration").Range("E23")
   
    Me.commande.List = DicoArt.Keys
    Me.commande.ListIndex = Me.commande.ListCount - 1
End Sub

Enrichi (BBcode):
Private Sub article_Change()
    Me.fournisseur.List = Split(DicoFour(Me.commande & Me.article), Chr(10))
    If Me.fournisseur.ListCount = 1 Then Me.fournisseur.ListIndex = 0
    Me.nombre = DicoQté(Me.commande.Text & Me.article.Text)
    Me.nombre.SetFocus
    Me.nombre.SelStart = 0
    Me.nombre.SelLength = Len(Me.nombre.Text)  
End Sub
Enrichi (BBcode):
Private Sub CBn_Ajouter_Click()
    If Me.facture <> "" And Me.nombre <> "" And Me.article.ListIndex >= 0 And Me.fournisseur.ListIndex >= 0 Then
        With Me.List_ordre
            .AddItem
            .List(memoire, 0) = Me.commande & Me.article
            .List(memoire, 1) = Me.article
            .List(memoire, 2) = Me.nombre
        End With
        memoire = memoire + 1
        Me.article = ""
        Me.nombre = ""
        Me.fournisseur = ""
    End If
End Sub
Enrichi (BBcode):
Private Sub CBn_Enregistrer_Click()
    Dim i%, Tb, tbArt
    Dim DcArt As New Scripting.Dictionary
    DcArt.CompareMode = TextCompare
    If Me.List_ordre.ListCount > 0 Then
        If MsgBox("Voulez-vous enregistrer cette transaction ?", vbYesNo) = vbYes Then
            Tb = Me.List_ordre.List
            tbArt = [_Tb_articles]
            For i = 1 To UBound(tbArt)
                DcArt(tbArt(i, 1)) = i
            Next i
            With Worksheets("Booking").[_Tb_Booking].ListObject
                For i = 0 To UBound(Tb)
                    If DicoBook.Exists(Tb(i, 0)) Then
                        With .ListRows(DicoBook(Tb(i, 0))).Range.Cells(1, 6)
                            .Value = .Value + Tb(i, 2)
                        End With
                    Else
                        If .ListRows.Count > 1 Or (.ListRows.Count = 1 And WorksheetFunction.CountA(.ListRows(1).Range) > 1) Then .ListRows.Add
                        With .ListRows(.ListRows.Count).Range
                            .Cells(1).Value = Me.Label_info.Caption
                            .Cells(2).Value = Me.facture
                            .Cells(3).Value = Me.commande
                            .Cells(4).Value = Me.fournisseur
                            .Cells(5).Value = Tb(i, 1)
                            .Cells(6).Value = Tb(i, 2)
                        End With
                    End If
                    With Worksheets("Article").[_Tb_articles].ListObject.ListRows(DcArt(Tb(i, 1))).Range
                        .Cells(5).Value = .Cells(5).Value + Tb(i, 2)
                    End With
                Next
            End With
            MsgBox "Le booking est fait !"
            Sheets("Configuration").Range("D23") = Sheets("Configuration").Range("D23") + 1
            Unload Me
            ThisWorkbook.Save
        End If
    End If
End Sub

J'ai un peu repris le code du formulaire Ajout_Commande (j'ai nommé les deux boutons de commande) :
Enrichi (BBcode):
Private Sub UserForm_Initialize()
    Me.Label_info.Caption = Sheets("Configuration").Range("E22") 
    Dim i As Integer, Tb
    Tb = [_Tb_articles]
    List_critique.ColumnWidths = "20"
    For i = 1 To UBound(Tb)
            If Tb(i, 9) <> "" Then
                List_critique.AddItem
                List_critique.Column(0, i - 1) = Tb(i, 1)
            End If
    Next i
End Sub
Enrichi (BBcode):
Private Sub CBn_Commander_Click()
    Dim Tb, Lrg As Range
    Dim ligne As Integer
    If Me.Liste_commande.ListCount > 0 And Me.fournisseur.ListIndex >= 0 Then
        'demander une confirmation de la commande
        If MsgBox("Voulez-vous passer la commande ?", vbYesNo) = vbYes Then
            Tb = Me.Liste_commande.List
            With Worksheets("Commande").[_Tb_Commandes].ListObject
                For ligne = 0 To UBound(Tb)
                    If .ListRows.Count = 1 And WorksheetFunction.CountA(.ListRows(1).Range) = 1 Then
                        Set Lrg = .ListRows(1).Range
                    Else
                        Set Lrg = .ListRows.Add.Range
                    End If
                    With Lrg
                    'Afficher nos informations dans la base de données
                        .Cells(1) = Me.Label_info.Caption
                        .Cells(2) = CDate(Now())
                        .Cells(3) = Me.Liste_commande.List(ligne, 0)
                        .Cells(4) = Me.Liste_commande.List(ligne, 1)
                        .Cells(5) = Me.Liste_commande.List(ligne, 2)
                        .Cells(6) = Me.Liste_commande.List(ligne, 4)
                        .Cells(7) = Me.Liste_commande.List(ligne, 3)
                        .Cells(9) = Me.fournisseur
                    End With
                Next ligne
            End With
   
            'sauvegarder le fichier pdf
            With Worksheets("Template_bdc")
                .Range("B4") = Date
                .Range("fourn") = Me.fournisseur.Value
                .Range("A11") = Me.Label_info.Caption
                .ExportAsFixedFormat Type:=xlTypePDF, _
                                     Filename:=Sheets("Configuration").Range("E28") & Me.Label_info, _
                                     openafterpublish:=True
            End With
       
            Sheets("Configuration").Range("D22") = Sheets("Configuration").Range("D22") + 1
            Unload Ajout_commande
        End If
    Else
        MsgBox "Aucune commande disponible !"
    End If
End Sub

J'ai fait plusieurs essais, ça à l'air de fonctionner ...
Teste le fichier en PJ.
MODIF : [_Tb_Articles] dans Ajout_Commande UserForm_Initialize ainsi que le fichier joint
Amicalement
Alain
 

Pièces jointes

  • somme quantité sur tableau.xlsm
    565.3 KB · Affichages: 2
Dernière édition:

cp4

XLDnaute Barbatruc
Bonjour à toutes & à tous, bonjour @RomainPOIRET, @cp4
J'ai décroché un long moment hier (PC allumé), mais je te réponds aujourd'hui.

Juste une question qui me turlupine :
Quand il t'arrive une commande incomplète avec une facture, n'as-tu pas une deuxième facture quand le solde te parvient ?​



C'était sans doute à cause du listrows.add lors du premier enregistrement (la ligne 1 n'est pas entièrement vide puisqu'il y a des formules, il faut tester le nombre de valeurs contenues dans cette ligne pour savoir s'il faut en ajouter une ou utiliser celle-là)

Dans un premier temps j'ai nommé tes tableaux structurés ( _Tb_Articles, _Tb_Commandes, _Tb_Booking, _Tb_Fournisseurs, _Tb_Personnel).

Dans le code j'ai mis en référence "Microsoft Scripting Runtime" pour avoir accès aux dictionnaires :
Regarde la pièce jointe 1136664
J'ai repris le code du formulaire Ajout_Booking (j'ai aussi inversé deux combobox et nommé les boutons de commande) :
Enrichi (BBcode):
Option Explicit
Public memoire As Integer
Dim DicoArt As New Scripting.Dictionary
Dim DicoFour As New Scripting.Dictionary
Dim DicoQté As New Scripting.Dictionary
Dim DicoCom As New Scripting.Dictionary
Dim DicoBook As New Scripting.Dictionary
Enrichi (BBcode):
Private Sub UserForm_Initialize()
    Dim tbC, tbB, i%
    DicoArt.CompareMode = TextCompare
    DicoFour.CompareMode = TextCompare
    DicoQté.CompareMode = TextCompare
    DicoCom.CompareMode = TextCompare
    DicoBook.CompareMode = TextCompare
    tbC = [_Tb_Commandes].Value
    tbB = [_Tb_Booking].Value
    For i = 1 To UBound(tbC)
        DicoArt(tbC(i, 1)) = IIf(DicoArt.Exists(tbC(i, 1)), DicoArt(tbC(i, 1)) & Chr(10), "") & tbC(i, 3)
        DicoQté(tbC(i, 1) & tbC(i, 3)) = DicoQté(tbC(i, 1) & tbC(i, 3)) + tbC(i, 6)
        DicoFour(tbC(i, 1) & tbC(i, 3)) = tbC(i, 9)
        DicoCom(tbC(i, 1) & tbC(i, 3)) = WorksheetFunction.Index(tbC, i, 0)
    Next i
    For i = 1 To UBound(tbB)
        DicoBook(tbB(i, 3) & tbB(i, 5)) = i
    Next i
    If DicoBook.Exists("") Then DicoBook.Remove ("")
    Me.Label_info.Caption = Sheets("Configuration").Range("E23")
  
    Me.commande.List = DicoArt.Keys
    Me.commande.ListIndex = Me.commande.ListCount - 1
End Sub

Enrichi (BBcode):
Private Sub article_Change()
    Me.fournisseur.List = Split(DicoFour(Me.commande & Me.article), Chr(10))
    If Me.fournisseur.ListCount = 1 Then Me.fournisseur.ListIndex = 0
    Me.nombre = DicoQté(Me.commande.Text & Me.article.Text)
    Me.nombre.SetFocus
    Me.nombre.SelStart = 0
    Me.nombre.SelLength = Len(Me.nombre.Text) 
End Sub
Enrichi (BBcode):
Private Sub CBn_Ajouter_Click()
    If Me.facture <> "" And Me.nombre <> "" And Me.article.ListIndex >= 0 And Me.fournisseur.ListIndex >= 0 Then
        With Me.List_ordre
            .AddItem
            .List(memoire, 0) = Me.commande & Me.article
            .List(memoire, 1) = Me.article
            .List(memoire, 2) = Me.nombre
        End With
        memoire = memoire + 1
        Me.article = ""
        Me.nombre = ""
        Me.fournisseur = ""
    End If
End Sub
Enrichi (BBcode):
Private Sub CBn_Enregistrer_Click()
    Dim i%, Tb, tbArt
    Dim DcArt As New Scripting.Dictionary
    DcArt.CompareMode = TextCompare
    If Me.List_ordre.ListCount > 0 Then
        If MsgBox("Voulez-vous enregistrer cette transaction ?", vbYesNo) = vbYes Then
            Tb = Me.List_ordre.List
            tbArt = [_Tb_articles]
            For i = 1 To UBound(tbArt)
                DcArt(tbArt(i, 1)) = i
            Next i
            With Worksheets("Booking").[_Tb_Booking].ListObject
                For i = 0 To UBound(Tb)
                    If DicoBook.Exists(Tb(i, 0)) Then
                        With .ListRows(DicoBook(Tb(i, 0))).Range.Cells(1, 6)
                            .Value = .Value + Tb(i, 2)
                        End With
                    Else
                        If .ListRows.Count > 1 Or (.ListRows.Count = 1 And WorksheetFunction.CountA(.ListRows(1).Range) > 1) Then .ListRows.Add
                        With .ListRows(.ListRows.Count).Range
                            .Cells(1).Value = Me.Label_info.Caption
                            .Cells(2).Value = Me.facture
                            .Cells(3).Value = Me.commande
                            .Cells(4).Value = Me.fournisseur
                            .Cells(5).Value = Tb(i, 1)
                            .Cells(6).Value = Tb(i, 2)
                        End With
                    End If
                    With Worksheets("Article").[_Tb_articles].ListObject.ListRows(DcArt(Tb(i, 1))).Range
                        .Cells(5).Value = .Cells(5).Value + Tb(i, 2)
                    End With
                Next
            End With
            MsgBox "Le booking est fait !"
            Sheets("Configuration").Range("D23") = Sheets("Configuration").Range("D23") + 1
            Unload Me
            ThisWorkbook.Save
        End If
    End If
End Sub

J'ai un peu repris le code du formulaire Ajout_Commande (j'ai nommé les deux boutons de commande) :
Enrichi (BBcode):
Private Sub UserForm_Initialize()
    Me.Label_info.Caption = Sheets("Configuration").Range("E22")
    Dim i As Integer, Tb
    Tb = [_Tb_article]
    List_critique.ColumnWidths = "20"
    For i = 1 To UBound(Tb)
            If Tb(i, 9) <> "" Then
                List_critique.AddItem
                List_critique.Column(0, i - 1) = Tb(i, 1)
            End If
    Next i
End Sub
Enrichi (BBcode):
Private Sub CBn_Commander_Click()
    Dim Tb, Lrg As Range
    Dim ligne As Integer
    If Me.Liste_commande.ListCount > 0 And Me.fournisseur.ListIndex >= 0 Then
        'demander une confirmation de la commande
        If MsgBox("Voulez-vous passer la commande ?", vbYesNo) = vbYes Then
            Tb = Me.Liste_commande.List
            With Worksheets("Commande").[_Tb_Commandes].ListObject
                For ligne = 0 To UBound(Tb)
                    If .ListRows.Count = 1 And WorksheetFunction.CountA(.ListRows(1).Range) = 1 Then
                        Set Lrg = .ListRows(1).Range
                    Else
                        Set Lrg = .ListRows.Add.Range
                    End If
                    With Lrg
                    'Afficher nos informations dans la base de données
                        .Cells(1) = Me.Label_info.Caption
                        .Cells(2) = CDate(Now())
                        .Cells(3) = Me.Liste_commande.List(ligne, 0)
                        .Cells(4) = Me.Liste_commande.List(ligne, 1)
                        .Cells(5) = Me.Liste_commande.List(ligne, 2)
                        .Cells(6) = Me.Liste_commande.List(ligne, 4)
                        .Cells(7) = Me.Liste_commande.List(ligne, 3)
                        .Cells(9) = Me.fournisseur
                    End With
                Next ligne
            End With
  
            'sauvegarder le fichier pdf
            With Worksheets("Template_bdc")
                .Range("B4") = Date
                .Range("fourn") = Me.fournisseur.Value
                .Range("A11") = Me.Label_info.Caption
                .ExportAsFixedFormat Type:=xlTypePDF, _
                                     Filename:=Sheets("Configuration").Range("E28") & Me.Label_info, _
                                     openafterpublish:=True
            End With
      
            Sheets("Configuration").Range("D22") = Sheets("Configuration").Range("D22") + 1
            Unload Ajout_commande
        End If
    Else
        MsgBox "Aucune commande disponible !"
    End If
End Sub

J'ai fait plusieurs essais, ça à l'air de fonctionner ...
Teste le fichier en PJ.

Amicalement
Alain
Bonjour,

@AtTheOne : Laborieux! Mon grain de sel: ajoute un 's' à article dans Tb = [_Tb_article] (Ajout_commande)

Bonne soirée.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla