Bonjour,
Je suis actuellement en train de travailler sur un formulaire de destock et j’ai un problème avec mon code VBA. Je souhaite lorsque je sélectionne la réf : EM00001 ajouter à ma Listbox
la réf EM00001
et automatiquement 2 fois plus de EM00002 et 3 fois plus de EM00003.
Voici mon code :
Private Sub btnajoutingredient_Click()
'Déclaration des variables
Dim nbcontroles As Integer
Dim x As Integer
nbcontroles = 9
If Me.col4.Value = "" And Me.col5.Value = "" Then
MsgBox "Veuillez entrer le nom ou la référence du produit que vous souhaitez commander."
Me.col6 = ""
Me.col8 = ""
Exit Sub
End If
If Me.col1.Value = "" Then
MsgBox "Veuillez entrer la date de la commande svp."
Exit Sub
End If
If Me.col6.Value = "" Then
MsgBox "Veuillez entrer la quantité commandée."
Exit Sub
End If
Dim rowData(1 To 7) As Variant ' Tableau pour stocker les données de chaque ligne
rowData(1) = Me.col2.Value
rowData(2) = Me.col1.Value
rowData(3) = Me.col4.Value
rowData(4) = Me.col5.Value
rowData(5) = Me.col6.Value
rowData(6) = Me.col7.Value
rowData(7) = Me.col8.Value
' Vérifier si la référence est "EM00001"
If Me.col5.Value = "EM00001" Then
x = Me.col6.Value ' Récupérer la quantité associée à la référence EM00001
' Appel direct à la fonction AjouterReference sans préfixe "Call"
Call AjouterReference(rowData, "EM00001", "Boite cadeau PM", x)
' Appel direct à la fonction AjouterReference sans préfixe "Call"
Call AjouterReference(rowData, "EM00002", "Paille en papier", x * 2)
' Appel direct à la fonction AjouterReference sans préfixe "Call"
Call AjouterReference(rowData, "EM00003", "Paille en plastique", x * 3)
Else
' Appel direct à la fonction AjouterReference sans préfixe "Call"
Call AjouterReference(rowData, Me.col5.Value, "Description Réelle", Me.col6.Value)
End If
Me.col3 = ""
Me.col4.Clear
Me.col5.Clear
Me.col6 = ""
End Sub
Private Sub AjouterReference(rowData() As Variant, ref As String, description As String, quantite As Integer)
’ Fonction pour ajouter les références à la ListBox
Dim rowIdx As Long
rowIdx = Me.Listpdtcde.ListCount ’ Index de la dernière ligne
Me.Listpdtcde.AddItem ref ' Colonne 1
Me.Listpdtcde.List(rowIdx, 1) = rowData(2) ' Colonne 2
Me.Listpdtcde.List(rowIdx, 2) = rowData(3) ' Colonne 3
Me.Listpdtcde.List(rowIdx, 3) = rowData(4) ' Colonne 4
Me.Listpdtcde.List(rowIdx, 4) = rowData(5) ' Colonne 5
Me.Listpdtcde.List(rowIdx, 5) = rowData(6) ' Colonne 6
Me.Listpdtcde.List(rowIdx, 6) = rowData(7) ' Colonne 7
' Si la référence est "EM00001", ajouter également "EM00002" et "EM00003" avec leurs quantités
If ref = "EM00001" Then
rowIdx = rowIdx + 1 ' Augmenter l'index pour ajouter "EM00002"
Me.Listpdtcde.AddItem "EM00002" ' Colonne 1
Me.Listpdtcde.List(rowIdx, 1) = rowData(2) ' Colonne 2
Me.Listpdtcde.List(rowIdx, 2) = "Paille en papier" ' Colonne 3
Me.Listpdtcde.List(rowIdx, 4) = quantite * 2 ' Colonne 5
rowIdx = rowIdx + 1 ' Augmenter l'index pour ajouter "EM00003"
Me.Listpdtcde.AddItem "EM00003" ' Colonne 1
Me.Listpdtcde.List(rowIdx, 1) = rowData(2) ' Colonne 2
Me.Listpdtcde.List(rowIdx, 2) = "Paille en plastique" ' Colonne 3
Me.Listpdtcde.List(rowIdx, 4) = quantite * 3 ' Colonne 5
End If
End Sub
Private Sub btnsup1ingredient_Click()
Dim i As Integer
For i = 0 To Me.Listpdtcde.ListCount Step 1
If Me.Listpdtcde.Selected(i) = True Then
Me.Listpdtcde.RemoveItem i
End If
Next i
If Listpdtcde.ListCount = 0 Then
Me.lblmessage = « Veuillez entrer sélectionné le type de produits commandés. »
End If
End Sub
Private Sub btnsupttingrédient_Click()
Me.Listpdtcde.Clear
End Sub
Private Sub col1_Change()
Dim newText As String
Dim charCount As Integer
Dim i As Integer
Dim c As String
' Supprimer tous les caractères non numériques pour ne garder que les chiffres
newText = ""
charCount = 0
For i = 1 To Len(col1.Text)
c = Mid(col1.Text, i, 1)
If IsNumeric(c) Then
newText = newText & c
charCount = charCount + 1
If charCount = 8 Then Exit For
End If
Next i
' Formater la date si la saisie comporte 8 caractères
If charCount = 8 Then
Dim dayPart As String
Dim monthPart As String
Dim yearPart As String
dayPart = Left(newText, 2)
monthPart = Mid(newText, 3, 2)
yearPart = Right(newText, 4)
newText = dayPart & "/" & monthPart & "/" & yearPart
End If
col1.Text = newText
col1.SelStart = Len(col1.Text)
End Sub
Private Sub col3_Change()
Dim ws_data As Worksheet
Dim lstrw As Long
Dim i As Integer
Dim uniqueValues As Collection ’ Collection pour stocker les valeurs uniques
col4.Clear
col5.Clear
Me.col4 = ""
Me.col5 = ""
Me.col6 = ""
Me.Col9.Clear ' Effacer la liste existante dans la colonne 9 (Col9)
Me.lblmessage = "Veuillez entrer le Nom ou la référence de l'article que vous souhaitez destocker."
' Vérifier que l'on a bien sélectionné un type de produit
If col3.Value <> "" Then
Set ws_data = Worksheets("CAT. PRODUIT")
lstrw = ws_data.Cells(Rows.Count, 3).End(xlUp).Row
Set uniqueValues = New Collection ' Initialiser la collection
For i = 2 To lstrw
If ws_data.Cells(i, 1) = col3.Value Then
' Vérifier si la valeur n'est pas déjà présente dans la collection
On Error Resume Next
uniqueValues.Add ws_data.Cells(i, 2), CStr(ws_data.Cells(i, 2))
On Error GoTo 0
End If
Next i
' Ajouter les éléments uniques à la colonne 9 (Col9)
On Error Resume Next
For Each Item In uniqueValues
Col9.AddItem Item
Next Item
On Error GoTo 0
End If
End Sub
Private Sub col7_Change()
If Not col7.Value = « » Then
’ Si col7 n’est pas vide, exécuter le reste du code ici
’ Par exemple, vous pouvez ajouter des actions spécifiques si col2 est non vide.
Me.lblmessage = « Veuillez choisir la catégorie de produit que vous souhaitez déstocker. » & col2.Value
Else
’ Si col est vide, afficher un message d’erreur ou effectuer une autre action.
MsgBox « Veuillez le nom du client / projet… »
End If
End Sub
Private Sub col5_AfterUpdate()
On Error GoTo 1
If WorksheetFunction.CountIf(Sheets(« LISTES »).Range(« U:U »), Me.col5) = 0 Then
MsgBox « Ce produit n’existe pas, veuillez vérifier le catalogue pdt ou entrer la référence. », vbOKOnly + vbInformation, « Erreur »
End If
With Me
Me.col4 = Application.WorksheetFunction.VLookup((Me.col5.Value), Sheets(« LISTES »).Range(« Trefproduit »), 2, 0)
End With
1
Me.lblmessage = « Entrer le quantité en commande. »
Me.col6 = « »
Me.col6.SetFocus
End Sub
Private Sub col4_AfterUpdate()
'Gestion des erreurs
On Error GoTo 1
'on verifie si la référence Tridi existe bien
If WorksheetFunction.CountIf(Sheets(« CATALOGUE »).Range(« A:A »), Me.col4.Value) = 0 Then
MsgBox « cette référence ingrédient n’existe pas. Veuillez vérifier la référence sur le catalogue. », vbInformation + vbOKOnly, « produit non trouvé »
Me.col5 = « »
Me.col6 = « »
Me.col4.SetFocus
End If
'Procédure de recherche v
With Me
'on applique le recherche pour afficher le nom de l’ingrédient à partir de la référence Tridi
Me.col5 = Application.WorksheetFunction.VLookup((Me.col4), Sheets(« CATALOGUE »).Range(« Tcatalogue »), 5, 0)
End With
Me.lblmessage = « Entrer la quantié en commande. »
Me.col6 = « »
Me.col6.SetFocus
1
End Sub
Private Sub Col9_Change()
Dim ws_data As Worksheet
Dim lstrw As Long
Dim i As Integer
col4.Clear
col5.Clear
Me.col4 = ""
Me.col5 = ""
Me.col6 = ""
Me.lblmessage = "Veuillez entrer le Nom ou la référence de l'article que vous souhaitez destocker."
' Vérifier que l'on bien sélectionné un type de produit
If Col9.Value <> "" Then
Set ws_data = Worksheets("CAT. PRODUIT")
lstrw = ws_data.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lstrw
If ws_data.Cells(i, 2) = Col9.Value Then
col4.AddItem "" & ws_data.Cells(i, 4)
col5.AddItem "" & ws_data.Cells(i, 3)
End If
Next
End If
End Sub
Private Sub UserForm_Initialize()
Me.col2 = Sheets(« COMMANDE CLIENT »).Range(« L2 »)
Me.lblmessage = « Veuillez entrer le date de commande et le nom du client / projet. »
End Sub
Lorsque j’ajoute l’ingrédient à ma commande cela n’ajoute que la réf EM00001 à ma listbox.
Merci d’avance de votre aide.
Aurélie