Ashraf Ehab

السلام عليكم ورحمة الله وبركاته ...ارجوا من الاساتذة الافاضل مساعدتي في هذا الكود انا اريد اضغط علي زر بحث يقوم بالبحث عن اسم المورد ويظهر 2 تكست بوكس بعدها يجمع كل بيانات المدفوع والمتبقي الي باسم المورد في ال2 تكست بوكس للتوضيح انا الي اريد عمله كالاتي ...اما اضغط اضافة في الفورم بضيف بيانات المورد فقط ...وحين اضافة فاتورة شراء بيترحل بعمود اخر غير العمود المحدد للاضافة ..اما في حالة البحث... فالبحث هيكون باسم المورد فيقوم بجمع قيم المتبقي والمدفوع في التكست بوكس المخفي ...وشكرا ...والله الموفق للجميع مرفق الملف مورد.xlsm

تم بنجاح حل مشكلة الترحيل الي الليست بوكس وقد تم كالتالي من اليوزر فورم قمت بكتابة هذا الكود Private Sub UserForm_Initialize() With Me.ListBox1 .ColumnCount = 14 .List = Range(Cells(1, 1), Cells(1, .ColumnCount)).Value .ColumnWidths = "100,100,100,150,100,100,100,100,150,100,100,100,100,100" End With End Sub وبعدها في زر اضافة للقائمة قمت بهذا الكود Private Sub cmdaddlist_Click() With Me.ListBox1 .AddItem Me.TextBox1 .List(.ListCount - 1, 1) = Me.TextBox2 .List(.ListCount - 1, 2) = Me.TextBox3 .List(.ListCount - 1, 3) = Me.TextBox4 .List(.ListCount - 1, 4) = Me.TextBox5 .List(.ListCount - 1, 5) = Me.TextBox6 .List(.ListCount - 1, 6) = Me.TextBox7 .List(.ListCount - 1, 7) = Me.TextBox8 .List(.ListCount - 1, 8) = Me.TextBox9 .List(.ListCount - 1, 9) = Me.TextBox10 .List(.ListCount - 1, 10) = Me.TextBox11 .List(.ListCount - 1, 11) = Me.TextBox12 .List(.ListCount - 1, 12) = Me.TextBox13 .List(.ListCount - 1, 13) = Me.TextBox14 Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" End With End Sub والان يوجد مشكلة بسيطة ان رؤس الاعمدة الخاصة بالمشتريات لا تظهر الا علي الشيت المفتوح حاليا بمعني لو كنت فاتح شيت تاني غير المشتريات يجبلي رؤوس المشتريات اكون شاكر جدا لو حد حللي المشكلة دي وشكرا

السادة الاساتذه السلام عليكم ورحمة الله وبركاته هل يوجد حل لترحيل البيانات من التيكيست بوكس الي الليست بوكس بالضغط علي زر اضافة للقائمةمع العلم ان عدد التيكست بوكس 14 بمعدل 14 عمود ومن الليست بوكس الي الشيت بعد الضغط علي زر اضافة القائمة في Purchasesform الموضوع ده ممكن صعب لكن مش مستحيل فلو حد عنده فكرة او طريقة تانيةاو مساعدة يكتبهالي انا عموما وصلت لحل جزئي في مشكلة ترحيل البيانات من التيكست بوكس الي الليست بوكس بالكود ده بس طبعا ده بيضيف مرة واحدة بس ولو مليت بيانات تانية بيشيل القديم مش بيزود عليه وانا شاكر جدا للجميع Private Sub cmdaddlist_Click() Dim xx(1, 14) xx(0, 1) = Me.TextBox1 xx(0, 2) = Me.TextBox2 xx(0, 3) = Me.TextBox3 xx(0, 4) = Me.TextBox4 xx(0, 5) = Me.TextBox5 xx(0, 6) = Me.TextBox6 xx(0, 7) = Me.TextBox7 xx(0, 8) = Me.TextBox8 xx(0, 9) = Me.TextBox9 xx(0, 10) = Me.TextBox10 xx(0, 11) = Me.TextBox11 xx(0, 12) = Me.TextBox12 xx(0, 13) = Me.TextBox13 xx(0, 14) = Me.TextBox14 ListBox1.List() = xx Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" End Sub dwork.xlsm

للرفع

للتوضيح اناحاولت علي قد ما اقدر احل المشكلة بس مش عارف محتاج بجد حد يساعدني عموما انا ضفت زر جديد لاضافة البيانات الي في الليست بوكس للشيت وطبعا البيانات كاملة مش هتروح لليست بوكس بسبب ان الاعمدة اكثر من 10 وقدرت اوصل البيانات الي هما 10 اعمدة فا في 4 اعمدة مش عارف اتصرف فيهم فياريت حد يشوفلي حل بحيث ينفذ نفس متغيرات ومعادلات الكود المشكلة الثانية الي بتحصل ان عندي قيمة الكمية*قيمة سعر الشراء الناتج بيجي في المتبقي والمدفوع اول ما يتكتب في ارقام يطرح من المتبقي المشكلة ان لو اخطائت وكتبت مثلا سعر الشراء غلط بعد ما طلع حاصل الضرب في المتبقي لو رجعت عدلت علي قيمة سعر الشراء بيضيف كأني ضفت كمية جديدة بسعر جديد ويضيف القيمة القديمة في المتبقي مع الجديدة ده كود معادلة الضرب والطرح Private Sub TextBox10_AfterUpdate() sm = Me.TextBox14.Value x1 = Val(Me.TextBox10.Value) * Val(Me.TextBox7.Value) Me.TextBox14.Value = Val(sm) + Val(x1) End Sub Private Sub TextBox13_AfterUpdate() Dim xai As Integer xai = Me.TextBox14.Value = Val(sm) + Val(x1) bi = Me.TextBox14.Value b1 = Val(Me.TextBox13.Value) - Val(Me.TextBox14.Value) Me.TextBox14.Value = Val(xai) - Val(b1) End Sub TextBox10 هو تكست سعر الشراء TextBox7 هو تكست الكمية TextBox13 هو تكست المدفوع TextBox14 هو تكست المتبقي ده الكود الي ضفته للزر الجديد Dim qp As Integer Dim rp As Integer Dim wp As Integer Dim ep As Integer qp = purchasesSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1 wp = ItemsSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ep = suppliersSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 rp = Me.ListBox1.ListCount Dim t As Range Dim firsttAddress As String Dim u As Integer Dim i As Integer Dim O As Integer u = Me.ListBox1.List(ListBox1.ListCount - 1, 1) i = Me.ListBox1.List(ListBox1.ListCount - 1, 3) With purchasesSheet.Range("E:E") Set t = .Find(u, LookIn:=xlValues) If Not t Is Nothing Then firsttAddress = t.Address O = purchasesSheet.Cells(t.Row, "G").Value O = O + i purchasesSheet.Cells(qp, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 0) purchasesSheet.Cells(qp, "E").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 1) purchasesSheet.Cells(qp, "F").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 2) purchasesSheet.Cells(qp, "G").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 3) purchasesSheet.Cells(qp, "I").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) purchasesSheet.Cells(qp, "J").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 5) purchasesSheet.Cells(qp, "K").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 6) purchasesSheet.Cells(qp, "L").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 7) purchasesSheet.Cells(qp, "M").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) purchasesSheet.Cells(qp, "N").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) ItemsSheet.Cells(t.Row, "D").Value = O 'Me.TextBox7.Value suppliersSheet.Cells(ep, "A").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) suppliersSheet.Cells(ep, "C").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) suppliersSheet.Cells(ep, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) 'suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value 'suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value Else purchasesSheet.Cells(qp, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 0) purchasesSheet.Cells(qp, "E").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 1) purchasesSheet.Cells(qp, "F").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 2) purchasesSheet.Cells(qp, "G").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 3) purchasesSheet.Cells(qp, "I").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) purchasesSheet.Cells(qp, "J").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 5) purchasesSheet.Cells(qp, "K").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 6) purchasesSheet.Cells(qp, "L").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 7) purchasesSheet.Cells(qp, "M").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) purchasesSheet.Cells(qp, "N").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) ItemsSheet.Cells(wp, "A").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 0) ItemsSheet.Cells(wp, "B").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 1) ItemsSheet.Cells(wp, "C").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 2) ItemsSheet.Cells(wp, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 3) ItemsSheet.Cells(wp, "F").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) ItemsSheet.Cells(wp, "G").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 5) ItemsSheet.Cells(wp, "H").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 6) ItemsSheet.Cells(wp, "i").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 7) suppliersSheet.Cells(ep, "A").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) suppliersSheet.Cells(ep, "C").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) suppliersSheet.Cells(ep, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) 'suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value 'suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value End If End With Me.TextBox5.Value = purchasesSheet.Cells(qp, "E").Value + 1 Me.TextBox2.Value = Date Me.TextBox3.Value = Format(Date, "ddd") Me.TextBox4.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" 'Me.TextBox9.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تاكيد" End Sub مرفق ملف الاكسيل dwork.xlsm

المشكلة الأولي تم حلها للتوضيح زر الاضافة عاوزه يعمل حاجتين عاوزه يضيف عادي البيانات زي ما هو دلوقتي في حالة بضيف صنف واحد بس اما الحاجة التانية لو في بيانات في الليست بوكس وضغط اضافة يعمل اضافة بنفس منطق اضافة البيانات الي في التكست بوكس بمعني عاوز الكود ده يضيف الي في الليست بوكس Private Sub cmdsave_Click() Dim ap As Integer Dim ip As Integer ap = purchasesSheet.Cells(Rows.Count, "c").End(xlUp).Row + 1 ip = ItemsSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 Dim C As Range Dim firstAddress As String Dim f As Integer Dim x As Integer Dim Y As Integer f = Me.TextBox5.Value x = Me.TextBox7.Value With purchasesSheet.Range("E:E") Set C = .Find(f, LookIn:=xlValues) If Not C Is Nothing Then firstAddress = C.Address Y = purchasesSheet.Cells(C.Row, "G").Value Y = Y + x purchasesSheet.Cells(ap, "A").Value = Me.TextBox1.Value purchasesSheet.Cells(ap, "B").Value = CDate(TextBox2.Value) purchasesSheet.Cells(ap, "C").Value = Me.TextBox3.Value purchasesSheet.Cells(ap, "D").Value = Me.TextBox4.Value purchasesSheet.Cells(ap, "E").Value = Me.TextBox5.Value purchasesSheet.Cells(ap, "F").Value = Me.TextBox6.Value purchasesSheet.Cells(ap, "G").Value = Me.TextBox7.Value purchasesSheet.Cells(ap, "H").Value = Me.TextBox8.Value purchasesSheet.Cells(ap, "I").Value = Me.TextBox9.Value purchasesSheet.Cells(ap, "J").Value = Me.TextBox10.Value purchasesSheet.Cells(ap, "K").Value = Me.TextBox11.Value purchasesSheet.Cells(ap, "L").Value = Me.TextBox12.Value purchasesSheet.Cells(ap, "M").Value = Me.TextBox13.Value purchasesSheet.Cells(ap, "N").Value = Me.TextBox14.Value ItemsSheet.Cells(C.Row, "D").Value = Y 'Me.TextBox7.Value Else purchasesSheet.Cells(ap, "A").Value = Me.TextBox1.Value purchasesSheet.Cells(ap, "B").Value = CDate(TextBox2.Value) purchasesSheet.Cells(ap, "C").Value = Me.TextBox3.Value purchasesSheet.Cells(ap, "D").Value = Me.TextBox4.Value purchasesSheet.Cells(ap, "E").Value = Me.TextBox5.Value purchasesSheet.Cells(ap, "F").Value = Me.TextBox6.Value purchasesSheet.Cells(ap, "G").Value = Me.TextBox7.Value purchasesSheet.Cells(ap, "H").Value = Me.TextBox8.Value purchasesSheet.Cells(ap, "I").Value = Me.TextBox9.Value purchasesSheet.Cells(ap, "J").Value = Me.TextBox10.Value purchasesSheet.Cells(ap, "K").Value = Me.TextBox11.Value purchasesSheet.Cells(ap, "L").Value = Me.TextBox12.Value purchasesSheet.Cells(ap, "M").Value = Me.TextBox13.Value purchasesSheet.Cells(ap, "N").Value = Me.TextBox14.Value ItemsSheet.Cells(ip, "A").Value = Me.TextBox4.Value ItemsSheet.Cells(ip, "B").Value = Me.TextBox5.Value ItemsSheet.Cells(ip, "C").Value = Me.TextBox6.Value ItemsSheet.Cells(ip, "D").Value = Me.TextBox7.Value ItemsSheet.Cells(ip, "E").Value = Me.TextBox8.Value ItemsSheet.Cells(ip, "F").Value = Me.TextBox9.Value ItemsSheet.Cells(ip, "G").Value = Me.TextBox10.Value ItemsSheet.Cells(ip, "H").Value = Me.TextBox11.Value ItemsSheet.Cells(ip, "i").Value = Me.TextBox12.Value End If End With Me.TextBox1.Value = "" Me.TextBox2.Value = "" 'Me.TextBox2.Value = "" 'Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox9.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تاكيد" End Sub طبعا المشكلة الي بتقابلني ان الليست بوكس لا يستوعب اكثر من 10 اعمدة

السلام عليكم انا عندي 3 مشاكل احتاج لحلها المشكلة الاولي اما المشكلة الثانية اما المشكلة الثالثة والاخيرة dwork.xlsm

شكرا لحضرتك تم حلها

السلام عليكم ورحمة الله وبركاته المشكلة عندي كما موضحها في الصورة زي ما انا موضح بضيف الكمية طيعي بكتب سعر الشراء طبيعي بيجيب في المتبقي حاصل ضرب الكمية في سعر الشراء المفروض اما اكتب قيمة في المدفوع يطرحها من المتبقي وبعد كله يبقي صحيح اضغط علي اضافة في القائمة يقوم باضافة البيانات في الليس بوكس فقط واما اضغط اضافة يرحل البيانات الي في الليست بوكس في الشيت اسف علي المطاولة dwork.xlsm

في البداية شكرا لمساعدة حضرتكوشكرا علي الكود انا قدرت اعدل عليه علشان انفذ الطلب الي انا محتاجه والتعديل الي قمت بيه هو ده Y = purchasesSheet.Cells(c.Row, "G").Value Y = Y + x purchasesSheet.Cells(ap, "A").Value = Me.TextBox1.Value purchasesSheet.Cells(ap, "B").Value = CDate(TextBox2.Value) purchasesSheet.Cells(ap, "C").Value = Me.TextBox3.Value purchasesSheet.Cells(ap, "D").Value = Me.TextBox4.Value purchasesSheet.Cells(ap, "E").Value = Me.TextBox5.Value purchasesSheet.Cells(ap, "F").Value = Me.TextBox6.Value purchasesSheet.Cells(ap, "G").Value = Me.TextBox7.Value purchasesSheet.Cells(ap, "H").Value = Me.TextBox8.Value purchasesSheet.Cells(ap, "I").Value = Me.TextBox9.Value purchasesSheet.Cells(ap, "J").Value = Me.TextBox10.Value purchasesSheet.Cells(ap, "K").Value = Me.TextBox11.Value purchasesSheet.Cells(ap, "L").Value = Me.TextBox12.Value purchasesSheet.Cells(ap, "M").Value = Me.TextBox13.Value purchasesSheet.Cells(ap, "N").Value = Me.TextBox14.Value ItemsSheet.Cells(c.Row, "D").Value = Y 'Me.TextBox7.Value ItemsSheet.Cells(c.Row, "D").Value = Y 'Me.TextBox7.Value كان لازم تضاف علشان تعمل المعادلة في شيت الاصناف ..شكرا لحضرتك مرة اخري علي مجهودك

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

السلام عليكم ورحمه الله ..عندي طلب معقد شوية أنا بستخدم اكواد ال VBA في الاكسيل بحاول اعمل في حالة إضافة فاتورة شراء إذا كان اسم الصنف المضاف في الفاتورة مطابق لاسم الصنف الموجود في الأصناف يقوم بجمع الكمية الموجودة في الأصناف مع الكمية الجديدة ويكون الإجمالي في الأصناف للتوضيح أنا عاوز اول ما اضغط علي إضافة في المشتريات هيضيف البيانات عادي في شيت المشتريات بس عاوزه اول ما يضيف الصنف في حالة اسم الصنف أو كود الصنف موجود في شيت الأصناف الي اسمه items Sheet يقوم بالذهاب الي خلية الكمية ويضيف كمية المشتريات علي كمية الاصناف الموجودة بالفعل طبعا لو عرفت اعمل كود الاضافة في المشتريات سهل اعمل العكس في المبيعات وشكرا dwork.xlsm