Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
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 ...
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 (...
Bonjour à toutes & à tous, bonjour @RomainPOIRET
Juste une petite question préalable :
Tes commandes peuvent-elles porter sur plusieurs articles ou comme cela semble être le cas avec ton exemple une commande = 1 et 1 seul article ?
Amicalement
Alain
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 :
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
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.
Bonsoir @cp4 Merci pour la correction, je modifie mon post 7
Oui laborieux ! en plus j'ajoute des erreurs (le s en dernière minute pour homogénéiser les noms des tableaux)
Amicalement
Alain
@AtTheOne pour répondre à ta question, non ca ne m'arrive pas ...
en tout cas, même si c'est laborieux, c'est exactement mon besoin ! alors merci pour ça
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.