mahmoud nasr alhasany

وعليكم السلام ورحمة الله وبركاتة وقد ساعدني بعض الإخوة في تعبئة هذا العمل ولكن هناك مشكلة في ذلك لا يتم خصم كمية المنتج الفرعي من المتجر Feuil1(“Stock”) هنا هو الرمز اليك الملف والصورة الموضحة Private Sub CmdValider_Click() On Error Resume Next If Datetr = "" Then Datetr.SetFocus MsgBox "يجب عليك إعطاء تاريخ." Exit Sub ElseIf Not IsDate(Datetr) Then Datetr = "" Datetr.SetFocus MsgBox "تاريخ غير صحيح." Exit Sub End If ' If ListBox1.ListIndex = -1 Then ' MsgBox "يجب عليك تحديد عنصر." ' Exit Sub ' End If If OptionButton1 = False And OptionButton2 = False Then MsgBox "يجب عليك اختيار خيار: المدخلات أو المخرجات." Exit Sub End If Set fa = Sheets("Stock") Lig = fa.Range("A:A").Find(ListBox1.Column(0, ListBox1.ListIndex), lookat:=xlWhole).Row If OptionButton1 = True Then Me.ComboBox1.Enabled = False fa.Range("F" & Lig) = fa.Range("F" & Lig) - ListBox1.Column(3, ListBox1.ListIndex) fa.Range("J" & Lig) = Datetr fa.Range("D" & Lig) = fa.Range("D" & Lig) Set fe = Sheets("Entrees") Lige = fe.Range("A" & Rows.Count).End(xlUp)(2).Row fe.Range("A" & Lige) = Application.Max(Lige - 2) + 1 fe.Range("C" & Lige) = ListBox1.Column(0, ListBox1.ListIndex) fe.Range("D" & Lige) = ListBox1.Column(1, ListBox1.ListIndex) fe.Range("E" & Lige) = ListBox1.Column(2, ListBox1.ListIndex) fe.Range("G" & Lige) = ListBox1.Column(3, ListBox1.ListIndex) fe.Range("H" & Lige) = ListBox1.Column(4, ListBox1.ListIndex) fe.Range("B" & Lige) = Datetr If Me.OptionButton1 = True Then fe.Range("F" & Lige) = "Entrée" ElseIf Me.OptionButton2 = True Then fe.Range("F" & Lige) = "Sortie" End If fe.Range("I" & Lige) = ComboBox1 fe.Range("J" & Lige) = ComboBox2 fe.Range("K" & Lige) = Format(Now, " ddd yyyy/mm/dd Time hh:mm:ss am/pm") ElseIf OptionButton2 = True Then 'If Me.ComboBox1 = "" Then: Me.ComboBox1.SetFocus: MsgBox "Vous devez selectionner un client.": Exit Sub If fa.Range("D" & Lig).Value = 0 Then MsgBox "la quantité de stock = 0.": Quantitetr = "": Quantitetr.SetFocus: Exit Sub 'If TextBox2.Value > fa.Range("G" & Lig) Then MsgBox "Vous ne pouvez pas sortir plus que ce qu'il y a en stock.": TextBox2 = "": TextBox2.SetFocus: Exit Sub If fa.Range("D" & Lig) < fa.Range("H" & Lig) Then MsgBox "Vous allez passer sous la quantité de stock mini." fa.Range("G" & Lig) = fa.Range("G" & Lig) + ListBox1.Column(3, ListBox1.ListIndex) fa.Range("J" & Lig) = Datetr fa.Range("D" & Lig) = fa.Range("D" & Lig) 'ListBox1.Column(0, ListBox1.ListIndex) = fa.Range("D" & Lig) Set fs = Sheets("Sorties") Ligs = fs.Range("A" & Rows.Count).End(xlUp)(2).Row fs.Range("A" & Ligs) = Application.Max(Ligs - 2) + 1 fs.Range("B" & Ligs) = ListBox1.Column(0, ListBox1.ListIndex) fs.Range("C" & Ligs) = ListBox1.Column(1, ListBox1.ListIndex) fs.Range("D" & Ligs) = ListBox1.Column(2, ListBox1.ListIndex) fs.Range("E" & Ligs) = ListBox1.Column(3, ListBox1.ListIndex) fs.Range("H" & Ligs) = ListBox1.Column(4, ListBox1.ListIndex) fs.Range("B" & Ligs) = Datetr If Me.OptionButton1 = True Then fs.Range("F" & Ligs) = "Entrée" ElseIf Me.OptionButton2 = True Then fs.Range("F" & Ligs) = "Sortie" End If fs.Range("I" & Ligs) = ComboBox1 fs.Range("J" & Ligs) = ComboBox2 fs.Range("K" & Ligs) = Format(Now, " ddd yyyy/mm/dd Time hh:mm:ss am/pm") End If Me.Quantitetr = "" Me.ComboBox1 = "" MsgBox "تم الحفظ." End Sub Gestion Stocks Magasin1.xlsm

السلام عليكم ورحمه الله وبركاته اريد عمل كود عند ادخال كميه صنف من مخزن معين فى الليست بوكس يقوم بخصم الكميه فى الشيت المخزون التابع للمخزن الاعمده الخاصه بالشيت A2 كود الصنف B2 اسم الصنف C2 الكميه ( المطلوب خصم الكميه مع كل ادراجها فى الليست بوك) E2 اسم المخزن انى عاجز عن اقوم بعمله الرجاء المساعده

مساء الخير من فضلكم ساعدوني لدي مربع قائمة يحتوي على كود الصنف والكمية بالإضافة إلى اسم المخزن الخاص به عند إرسال الكمية من مربع القائمة إلى ورقة المخزون، يتم تحديث كمية العنصر الموجود في المخزن مع العلم كود الصنف A2 اسم الصنف B2 كميه المخزون C2 اسم المخزن D2 هل هناك أي كود يلبي متطلبات المشروع الرجاء مساعدتي؟ مع إعطاء فورم بذلك

هل يوجد شئ غير مفهوم فى هذه المسألة تودون أن اوضحها لكم

رجاء مساعدتى اريد خصم الكمية من المخزن الزى تم صرف الكميه من الليست بوكس إلى شيت المخزون وانفترض أن الكميه المننصرفة فى الليست بوكس هى ٥ كرتونه و الكميه الموجوده فى شيت المخزون هى ٢٠ المفروض يكون الكميه فى المخزون بدل ٢٠ تكون الكميه ١٥ كرتونة كما موضح فى الصورة رجاء مساعدتى

صباح الخير

رجاء مساعدتى ضرورى إذا امنكنكم ما الخلل فى الكود المدرج

Private Sub MajInventaire() Dim v As Integer With Worksheets("Inventaire") lgD = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For v = 0 To ListBox1.ListCount - 1 With .Cells(lgD, 3) If flgAdd = 0 Then .Offset(, -2) = ListBox1.List(v, 1) 'Code article .Offset(, -1) = ListBox1.List(v, 4) 'Catégorie .Offset(, 2) = ListBox1.List(v, 5) 'Seuil d'alerte .Offset(, 3) = ListBox1.List(v, 6) 'Descriptif .Offset(, 4) = ListBox1.List(v, 7) 'Référence .Offset(, 5) = ListBox1.List(v, 8) 'Unité de mesure .Offset(, 6) = "Transfert" 'Observations .Offset(, 9) = ComboBox2 'Magasin QD = Val(.Value) + QT: .Value = QD 'Stock actuel Else .Offset(, 7) = .Offset(, 7) + ListBox1.List(v, 9) End If lgT = lgT + 1 End With .Protect Next v End With End Sub صباح الخير هل يمكنكم مساعدتى الكود الذى ادرجتة لايعمل معى الكمية لاتخصم من شيت Inventaire ما الأخطاء فى هذا الكود copy-of-copy-of-quantite-transferee-4.xlsm

لايوجد حل غير الغاء الجدول (بيانات الخلايا بدون ادراج جداول عليها)

هذا صحيح ا / محمد هشام Private Sub UserForm_Initialize() Dim c As Object, AL As Object, i As Long, d As Object tbl = [T_listrayon].Value '****************** Produits Tri tbl, LBound(tbl), UBound(tbl), 1 Me.Rayon.list = tbl Me.rayon_vente.list = tbl tbl = [Client].Value '****************** Clients Tri tbl, LBound(tbl), UBound(tbl), 3 Me.Recherche.list = tbl Me.nom_vente.list = tbl tbl = [T_Fournisseur].Value '****************** Fournisseur Tri tbl, LBound(tbl), UBound(tbl), 2 Me.cherche_fournisseur.list = tbl Me.fournisseur.list = tbl Me.max_fournisseur = [T_Fournisseur].Rows.Count + 1 Me.Scrollfournisseur.Max = Me.max_fournisseur Me.derenrg = [Produits].Rows.Count + 1 Me.Scrollproduit.Max = Me.derenrg Me.derclient = [Client].Rows.Count + 1 Me.ScrollClients.Max = Me.derclient Me.TxtDate = Format(Date, "dd/mm/yyyy") End Sub Private Sub produit_vente_Change() 'vente Dim rep As Byte If Me.produit_vente.ListIndex = -1 And Me.produit_vente = "" Then Exit Sub If Me.produit_vente.ListIndex = -1 And Me.produit_vente <> "" Then rep = MsgBox("Le produit doit être créé avec la page produit", vbCritical, "Contrôle") Exit Sub End If Me.enrgproduit = Me.produit_vente.Column(1) enreg = Val(Me.enrgproduit.Value) Me.stock_vente = [Produits].Item(enreg, 4) Me.TVAvente = [Produits].Item(enreg, 6) Me.prix_vente = Format([Produits].Item(enreg, 8), "#,##0.00") Me.mini_vente = [Produits].Item(enreg, 10) ComboBox4 = [Produits].Item(enreg, 11) End Sub رأيت هذا عندما أنقر على القائمة المنسدلة (product_sale)، يؤدي ذلك إلى زيادة المساحة في محتوى الورقة المخصصة لها ما هو الخطأ في الكود؟

الف شكر ا / محمد هشام وكل سنة وانت طيب

صباح الخير عليكم جميعا Private Sub rayon_vente_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'vente Dim i As Long, monproduit, lig As Integer If ctrl = True Then Exit Sub If Me.rayon_vente.ListIndex = -1 Then If [T_listrayon].Item(1, 1) = "" Then lig = 1 Else lig = [T_listrayon].Rows.Count + 1 [T_listrayon].Item(lig, 1) = Me.rayon_vente tbl = [T_listrayon].Value Tri tbl, LBound(tbl), UBound(tbl), 1 Me.Rayon.list = tbl Me.rayon_vente.list = tbl End If 'Me.produit_vente.Clear monproduit = [Produits].Value For i = 1 To UBound(monproduit) If monproduit(i, 2) = Me.rayon_vente Then Me.produit_vente.AddItem monproduit(i, 3) Me.produit_vente.list(Me.produit_vente.ListCount - 1, 1) = i Me.ComboBox4.AddItem monproduit(i, 11) Me.ComboBox4.list(Me.ComboBox4.ListCount - 1, 1) = i End If Next i ' Me.ComboBox4.Clear 'Me.prix_vente = "": Me.stock_vente = "": Me.TVAvente = "": Me.quantite_vente = "" End Sub عند تختار اسم الصنف من الكومبوبوكس يوجد فراغ فى القائمة المنسدلة فما سبب المشكلة Gest_magasin.xlsm

صباح الخير هذا الكود لايحدث المخزون بالقيمة الصحيحة فما الخطاء هنا Private Sub valid_vente_Click() 'valider vente On Error Resume Next Dim i As Integer, lig As Long, rep As Byte If Me.OptionButton1 = False And Me.OptionButton2 = False And Me.OptionButton3 = False Then rep = MsgBox("Vous n'avez oas choisi de moyen de paiement", vbCritical, "Contrôle") Exit Sub End If If Me.Total_vente = "" Then Exit Sub 'effacer facture Sheets("Facture").Range("F2:f6").ClearContents Sheets("Facture").Range("A11:E46").ClearContents Sheets("Facture").Range("B8,E8").ClearContents Sheets("Facture").Range("B8").Value = Year(Date) & "-" & Format(Sheets("Facture").Range("L1").Value + 1, "0000") Sheets("Facture").Range("L1").Value = Sheets("Facture").Range("L1").Value + 1 'N° Facture Sheets("Facture").Range("E8").Value = Date 'date Sheets("Facture").Range("F2").Value = Me.nom_vente.Value If Me.nom_vente <> "" Then Sheets("Facture").Range("F3").Value = [Client].Item(Me.nom_vente.Column(0), 3) Sheets("Facture").Range("F4").Value = [Client].Item(Me.nom_vente.Column(0), 4) Sheets("Facture").Range("F5").Value = [Client].Item(Me.nom_vente.Column(0), 5) Sheets("Facture").Range("F6").Value = [Client].Item(Me.nom_vente.Column(0), 6) End If For i = 0 To ListBox1.ListCount - 1 Sheets("Facture").Range("A" & 11 + i) = Me.ListBox1.List(i, 1) 'Rayon Sheets("Facture").Range("B" & 11 + i) = Me.ListBox1.List(i, 2) 'article Sheets("Facture").Range("E" & 11 + i) = Me.ListBox1.List(i, 4) 'tva Sheets("Facture").Range("D" & 11 + i) = Me.ListBox1.List(i, 6) 'prix de vente Sheets("Facture").Range("C" & 11 + i) = Me.ListBox1.List(i, 5) 'quantité Sheets("Facture").Range("G47") = CDbl(Me.Remise) 'mettre a jour mouvement et stock If [Mouvement].Item(1, 1) = "" Then lig = 1 Else lig = [Mouvement].Rows.Count + 1 [Mouvement].Item(lig, 1) = Me.ListBox1.List(i, 1) 'Rayon [Mouvement].Item(lig, 2) = Me.ListBox1.List(i, 2) 'article [Mouvement].Item(lig, 4) = Me.ListBox1.List(i, 5) 'quantite [Mouvement].Item(lig, 5) = Date [Mouvement].Item(lig, 7) = "Vente " & Me.nom_vente.Value ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 0))), 4) = [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 6))), 4) - [Mouvement].Item(lig, 4) [Mouvement].Item(lig, 6) = [Produits].Item(CLng(Me.ListBox1.List(i, 0)), 4) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Next i If Me.OptionButton1 = True Then [Mouvement].Item(lig, 8) = Me.OptionButton1.Caption If Me.OptionButton2 = True Then [Mouvement].Item(lig, 8) = Me.OptionButton2.Caption If Me.OptionButton3 = True Then [Mouvement].Item(lig, 8) = Me.OptionButton3.Caption [Mouvement].Item(lig, 10) = ComboBox4 [Mouvement].Item(lig, 9) = CDbl(Me.Total_vente) Me.facture.Visible = True rep = MsgBox("Cliquez sur Facture, Nouveau ou Quitter", vbOKOnly, "Vente enregistrée.") End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'اريد اضيف خيار ثالث يشمل اسم المخزن ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 0))), 4) = [Produits].Item(CLng(CInt(Me.ListBox1.List(i, 6))), 4) - [Mouvement].Item(lig, 4) [Mouvement].Item(lig, 6) = [Produits].Item(CLng(Me.ListBox1.List(i, 0)), 4) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' مخزن.xlsm

On Error Resume Next Dim i As Integer, MyRow As Integer, ii As Integer, Abu_Ahmed As Boolean Dim Sh_A As Worksheet Dim AA As Integer On Error Resume Next Application.ScreenUpdating = False For i = 4 To Sheets("Stock").Range("A1000").End(xlUp).Row If ComboBox2 = Sheets("Stock").Cells(i, 12) And Val(CB_Pièce) = Sheets("Stock").Cells(i, 1) Then MyRow = Sheets("Stock").Cells(i, 1).Row Abu_Ahmed = True GoTo 1 Exit For End If Next 1 If Abu_Ahmed = True Then Else If MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى" & Me.ComboBox2, vbYesNo) = vbYes Then If MsgBox("هل تريد المتابعة الى شاشة اضافة هذا الصنف الى المخزن", vbYesNo) = vbYes Then UserForm9.Show Else TextBox_Stock_Initial.Value = "0" MsgBox "هل تريد الالغاء" Exit Sub End If End If End If Application.ScreenUpdating = True تم اصلاح مشكلة الحدث

نعم انه بالفعل فى شيت stock ولاكن المشكله ان الرسالة تتكرر واضيف صور لذلك الرسالة الثانية لا اريدها ان تتكرر يتم الالغاء MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى مخزن 5") عندما اعطى الامر لا يأتى هذا الامر MsgBox("هذا الصنف لايوجد فى قواعد البيانات فى")