Ashraf Ehab

تم شكرا لحضرتك ولك جزيل الشكر

السلم عليكم ورحمة الله وبركاته الاخوة الاعزاء : ارجو مساعدتي في هذا الكود اريد عمل اذا وقف الماوس علي البوتون يطهر الفريم وهذا قم به ولكن اريد اذا المؤشر بعد عن البوتون يخفي الفريم مدرج الملفtry.xlsm

طيب هل موجود ما هو مطلوب او يمكن عمله من عدمه شكرا

السلام عليكم ورحمة الله وبركاته اخواتي الاعزاء برجاء المساعدة في طلبي هذا : اريد ان اقوم بعمل نسخ للشيت ونقله علي جهاز اخر ويتم مشاركة البيانات علي نفس الشيت عند الجهازين في نفس الوقت عبر الانترنت علي ثبيل المثال جهاز 1 قام بعملية بيع جهاز 2 يري انه تم البيع وعدد الاصناف نقصة وهكذا واا لم يكن هناك انترنت يتم تحديث العمليات عند توافر الانترنت شكرا وجزاكم الله خيرا مرفق لينك تحميل الملف https://www.mediafire.com/file/bg4i539n0q4l81l/حسابات.xlsm/file

شكرا لك اخي الفاضل ولكني لم استطع استخدام الكود فهل يمكنك التوضيح قليلا

السلام عليكم ورحمة الله وبراكاته الاساتذة الافاضل انا اريد تنفيذ الاتي فارجو المساعدة ولو حتي بالفكرة او ترتيب الافكار اما بعد انا مصمم 16 مربع او بمعني اصح 16 ليبول علي شكل مربع وهناك ليبول في المنتصف به عد تنازلي التفاصيل المربع بالمنتصف اريد ان يقوم بعملين الاول وقت فتح الفورم يقوم بعد تنازلي 35 ثانية وبعد ال35 ثانية تبداء نقطة او ظل بلون مختلف بالدوران بالتوالي علي ال16 ليبول لمدة 8 ثواني ويظهر بعد ال8 ثواني مربع به عداد 17 ثانية بالناتج الواقف عليه وبعد ال17 يختفي المربع الجديد ويداء ال35 ثانية بالعد مرة اخري وهكذا ولكن الحركة الاقدة تبداء من اخر مكان كان واقف عليها مرفق تصميم مبدائي وجزاكم الله خيرا Play.xlsm

اخي الكريم شكرا لك ولكن نفس الوضع لا تزال تقوم بفتح الشاشة التي بالصورة الأولي أما الثانية لم تعد تظهر ثانيا لا اريدها ان تحل هذه المشكلة علي جهازي فقط ولكن حين نقله علي جهاز اخر يقوم بفتح الفورم تلقائيا ولا يفتح هذه القوائم اولا الاسم والباسورد لدخول البرنامج admin admin أما الدخول للبرمجة ashraf dim

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

تم الحل المشكلة كانت في الجهاز

المشكلة لا تزال موجودة ايضا ممكن حضرتك تشرحلي الاكواد الي حضرتك عدلتها وانا اعدلها بنفسي وممكن تكون المشكلة عندي من الجهاز نفسه ساقوم بتجربة الملف علي جهاز اخر

نفس المشكلة يا اخي للتوضيح حين الضغط علي زر البرمجة يفتح كما في الصورة التعديل يعمل بصورة طبيعة وعند الحفظ يحفظ تبيعي ويظل الشيتين المسميان ب excel مفتوحان لا يغلقان الا اذا فتحت شيت جديد واغلقته

نفس المشكلة شكرا لك يمكنني التكيف علي هذا الوضع

بارك الله فيك تم الحل ولكنه يفتح شيت فارغ ولا يغلق الا إذا فتحت شيت جديد وإغلاقه يغلق

السلام عليكم ورحمة الله وبركاته الاساتذة الافاضل ظهر لي مشكلة غريبة بعد اما انتهيت من البرنامج جعلته يفتح تلقائي من loginformبيوزر نيم وباسورد وكل ده تمام في بوتون عاملها جوه تظهرلي شيت الاكسيل بيظهر عادي بس بيمنعني اكتب اي حاجة بالكيبورد سواء في الاكواد او الشيتات وبعد اما اغلق بلاقي الي في الصورة دي username:admin passwored:admin هل يوجد حل ام لا وشكرا dwork.xlsm

شكرا لك استاذ محمد على مجهودك معي لقد تم الامر بناء علي توجيهاتك

شكرا لك يا استاذ محمد ولكن كيف انفذ هذا الكود وهناك شئ اخر النموذج يمكنه ان يغلق ويفتح اكثر من مرةفي نفس اليوم وقتها سيضيف قيمتها اكثر من مرة وانا احتاجها تحتفظ باخر قيمة لها قبل اليوم الجديد حتي ولو بخمس دقائق

السلام عليكم ورحمة الله وبركاته الاخوة الاعزاء والاساتذة الافاضل احب ان استفسر عن امكانية تثبيت قيمة ليبول او تكست بوكس التفاصيل كالاتي انا عامل ليبول مخفي بيستدعي مجموع المشتريات ويطرح منها مجموع المبيعات ومخلي ليبول ظاهر بيستدعي بيانات الليبول المخفي بهذا الكود Me.Label3.Caption = Val(Me.Label3.Caption) + Val(Me.de.Caption) المطلوب ان اذا انتهي اليوم علي قيمة معينه في label 3 يثيت هذه القيمة في اليوم الجديد ويجمعها مع متغيرات de ولكم جزيل الشكر والعرفان de.xlsm

الحمد لله الذي وفقني للحل اولا احب اشكر الاستاذ محمد صالح لانه ساعدني كثيرا بهذه الفكرة ثانيا تم حل المشكلة بالكود الاتي Dim sc As Integer sc = customersSheet.Range("A10000").End(xlUp).Row + 1 Dim c, cv As Range Dim firstAddress, nfe As String Dim f, nf As Integer Dim x As Integer Dim Y As Integer Dim last, last1, lse As Integer last = SelesSheet.Range("A10000").End(xlUp).Row + 1 last1 = ShortfallsSheet.Range("A10000").End(xlUp).Row + 1 For i = 0 To ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(i, 4) lse = ShortfallsSheet.Range("N1").Value nfe = Me.ListBox1.List(i, 4) f = Me.ListBox1.List(i, 3) x = Me.ListBox1.List(i, 1) With ItemsSheet.Range("B:B") Set c = .Find(f, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Y = ItemsSheet.Cells(c.Row, "D").Value Y = Y - x a = ItemsSheet.Cells(c.Row, "A").Value a = a b = ItemsSheet.Cells(c.Row, "B").Value b = b cc = ItemsSheet.Cells(c.Row, "C").Value cc = cc d = ItemsSheet.Cells(c.Row, "D").Value d = d e = ItemsSheet.Cells(c.Row, "E").Value e = e ff = ItemsSheet.Cells(c.Row, "F").Value ff = ff g = ItemsSheet.Cells(c.Row, "G").Value gg = gg j = ItemsSheet.Cells(c.Row, "J").Value j = j SelesSheet.Cells(last, "I").Value = Me.ListBox1.List(i, 4) SelesSheet.Cells(last, "J").Value = Me.ListBox1.List(i, 3) SelesSheet.Cells(last, "K").Value = Me.ListBox1.List(i, 2) SelesSheet.Cells(last, "L").Value = Me.ListBox1.List(i, 1) SelesSheet.Cells(last, "M").Value = Me.ListBox1.List(i, 0) ItemsSheet.Cells(c.Row, "D").Value = Y last = last + 1 End If End With Next i Sheets("Shortfalls").Select For Each hh In Range("a1:a" & Range("a10000").End(xlUp).Row) If hh Like nfe & "*" Then ShortfallsSheet.Cells(lse, "D").Value = d - x ElseIf d <= j Then Exit For ShortfallsSheet.Cells(last1, "A").Value = a ShortfallsSheet.Cells(last1, "B").Value = b ShortfallsSheet.Cells(last1, "C").Value = cc ShortfallsSheet.Cells(last1, "D").Value = d - x ShortfallsSheet.Cells(last1, "E").Value = e ShortfallsSheet.Cells(last1, "F").Value = ff ShortfallsSheet.Cells(last1, "G").Value = g last1 = last1 + 1 End If Next Dim ls1 As Integer Dim ls2 As Integer ls1 = SelesSheet.Range("A10000").End(xlUp).Row + 1 ls2 = SelesSheet.Range("I10000").End(xlUp).Row For s = ls1 To ls2 SelesSheet.Cells(ls1, "A").Value = Me.TextBox1.Value SelesSheet.Cells(ls1, "B").Value = Me.TextBox2.Value SelesSheet.Cells(ls1, "C").Value = Me.TextBox3.Value SelesSheet.Cells(ls1, "D").Value = Me.ComboBox1.Value SelesSheet.Cells(ls1, "E").Value = Me.TextBox13.Value SelesSheet.Cells(ls1, "F").Value = Me.TextBox11.Value SelesSheet.Cells(ls1, "G").Value = Me.TextBox12.Value SelesSheet.Cells(ls1, "H").Value = Me.TextBox14.Value SelesSheet.Cells(ls1, "N").Value = Time customersSheet.Cells(sc, "A").Value = Me.ComboBox1.Value customersSheet.Cells(sc, "C").Value = Me.TextBox11.Value customersSheet.Cells(sc, "B").Value = "ãÈíÚÇÊ" customersSheet.Cells(sc, "D").Value = Me.TextBox12.Value customersSheet.Cells(sc, "E").Value = Me.TextBox2.Value customersSheet.Cells(sc, "F").Value = Me.TextBox3.Value customersSheet.Cells(sc, "G").Value = Time ls1 = ls1 + 1 Next s MsgBox "Êã ÇÖÇÝÉ ÇáÈíÇäÇÊ ÈäÌÇÍ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÊÇßíÏ" اشكر الاستاذ محمد صالح مرة اخري علي نصيحتة

تم حل مشكلة مسح البيانات بنجاح وتبقي المشكلة الاولي وحل مشكلة المسح كانت كالاتي 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, ldelet As String Dim u As Integer Dim i As Integer Dim O As Integer Dim ii As Long For ii = 1 To Me.ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(ii, 3) ldelet = ShortfallsSheet.Range("N1").Value u = Me.ListBox1.List(ii, 4) i = Me.ListBox1.List(ii, 6) With ItemsSheet.Range("B:B") Set t = .Find(u, LookIn:=xlValues) If Not t Is Nothing Then firsttAddress = t.Address O = ItemsSheet.Cells(t.Row, "D").Value O = O + i d = ItemsSheet.Cells(t.Row, "D").Value d = d j = ItemsSheet.Cells(t.Row, "J").Value j = j purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Cells(t.Row, "D").Value = O 'Me.TextBox7.Value ItemsSheet.Cells(t.Row, "G").Value = Me.ListBox1.List(ii, 9) ItemsSheet.Cells(t.Row, "H").Value = Me.ListBox1.List(ii, 10) ItemsSheet.Cells(t.Row, "I").Value = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time Else purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 3) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 4) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 5) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 6) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 7) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 8) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 9) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 10) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.TextBox13.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.TextBox14.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 1) 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 2) End If End With Next ii If j < d Then ShortfallsSheet.Cells.Rows(ldelet).Delete End If 'Me.TextBox5.Value = Me.ListBox1.List(ii, 4) + 1 Me.TextBox4.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 = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد" End Sub ارجو مساعدتي في المشكلة الاولي وانا احاول حلها وشكرا للجميع

بالاضافة الي في المشتريات بحاول اما يجد العمود يقوم بمسحه ولكن الكود لا ينفذ وهذا هو الكود 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, ldelet As String Dim u As Integer Dim i As Integer Dim O As Integer Dim ii As Long For ii = 1 To Me.ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(ii, 3) ldelet = ShortfallsSheet.Range("N1").Value u = Me.ListBox1.List(ii, 4) i = Me.ListBox1.List(ii, 6) With ItemsSheet.Range("B:B") Set t = .Find(u, LookIn:=xlValues) If Not t Is Nothing Then firsttAddress = t.Address O = ItemsSheet.Cells(t.Row, "D").Value O = O + i d = ItemsSheet.Cells(t.Row, "D").Value d = d j = ItemsSheet.Cells(t.Row, "J").Value j = j purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Cells(t.Row, "D").Value = O 'Me.TextBox7.Value ItemsSheet.Cells(t.Row, "G").Value = Me.ListBox1.List(ii, 9) ItemsSheet.Cells(t.Row, "H").Value = Me.ListBox1.List(ii, 10) ItemsSheet.Cells(t.Row, "I").Value = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time Else purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 3) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 4) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 5) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 6) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 7) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 8) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 9) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 10) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.TextBox13.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.TextBox14.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 1) 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 2) End If End With Next ii If j < d Then ShortfallsSheet.Rows(ldelet).Delete End If 'Me.TextBox5.Value = Me.ListBox1.List(ii, 4) + 1 Me.TextBox4.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 = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد" End Sub

نصيحة ممتازة واشكرك علي هذه النصيحة ولكن ظهر لي خطاء في حالة بيع كمية اخري وهي في النواقص تخصم الكمية فقط ولا تضيف البيانات مرة اخري وحللت هذه المكشلة ولكن اذا بعت صنف جديد ليس في القائمة يعطيني هذا الخطا وهذا هو الكود Dim c As Range Dim firstAddress, nfe As String Dim f As Integer Dim x As Integer Dim Y As Integer Dim last, last1, lse As Integer last = SelesSheet.Range("A10000").End(xlUp).Row + 1 last1 = ShortfallsSheet.Range("A10000").End(xlUp).Row + 1 For i = 0 To ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(i, 4) lse = ShortfallsSheet.Range("N1").Value f = Me.ListBox1.List(i, 3) x = Me.ListBox1.List(i, 1) With ItemsSheet.Range("B:B") Set c = .Find(f, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Y = ItemsSheet.Cells(c.Row, "D").Value Y = Y - x a = ItemsSheet.Cells(c.Row, "A").Value a = a b = ItemsSheet.Cells(c.Row, "B").Value b = b cc = ItemsSheet.Cells(c.Row, "C").Value cc = cc d = ItemsSheet.Cells(c.Row, "D").Value d = d e = ItemsSheet.Cells(c.Row, "E").Value e = e ff = ItemsSheet.Cells(c.Row, "F").Value ff = ff g = ItemsSheet.Cells(c.Row, "G").Value gg = gg j = ItemsSheet.Cells(c.Row, "J").Value j = j SelesSheet.Cells(last, "I").Value = Me.ListBox1.List(i, 4) SelesSheet.Cells(last, "J").Value = Me.ListBox1.List(i, 3) SelesSheet.Cells(last, "K").Value = Me.ListBox1.List(i, 2) SelesSheet.Cells(last, "L").Value = Me.ListBox1.List(i, 1) SelesSheet.Cells(last, "M").Value = Me.ListBox1.List(i, 0) ItemsSheet.Cells(c.Row, "D").Value = Y last = last + 1 End If End With Next i nfe = ShortfallsSheet.Cells(lse, "A").Value If a = nfe Then ShortfallsSheet.Cells(lse, "D").Value = d - x ElseIf d <= j Then ShortfallsSheet.Cells(last1, "A").Value = a ShortfallsSheet.Cells(last1, "B").Value = b ShortfallsSheet.Cells(last1, "C").Value = cc ShortfallsSheet.Cells(last1, "D").Value = d - x ShortfallsSheet.Cells(last1, "E").Value = e ShortfallsSheet.Cells(last1, "F").Value = ff ShortfallsSheet.Cells(last1, "G").Value = g last1 = last1 + 1 lse = lse + 1 End If Dim ls1 As Integer Dim ls2 As Integer ls1 = SelesSheet.Range("A10000").End(xlUp).Row + 1 ls2 = SelesSheet.Range("I10000").End(xlUp).Row For s = ls1 To ls2 SelesSheet.Cells(ls1, "A").Value = Me.TextBox1.Value SelesSheet.Cells(ls1, "B").Value = Me.TextBox2.Value SelesSheet.Cells(ls1, "C").Value = Me.TextBox3.Value SelesSheet.Cells(ls1, "D").Value = Me.ComboBox1.Value SelesSheet.Cells(ls1, "E").Value = Me.TextBox13.Value SelesSheet.Cells(ls1, "F").Value = Me.TextBox11.Value SelesSheet.Cells(ls1, "G").Value = Me.TextBox12.Value SelesSheet.Cells(ls1, "H").Value = Me.TextBox14.Value ls1 = ls1 + 1 Next s MsgBox "Êã ÇÖÇÝÉ ÇáÈíÇäÇÊ ÈäÌÇÍ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÊÇßíÏ" والله الموفق للجميع dwork.xlsm

السلام عليكم ورحمة الله وبركاته الاساتذة الافاضل انا احتاج مساعدة في عمل هذا الكود انا اريد وقت اضافة صنف يوجد تكست بوكس اسمه اقل كمية يتم الكتابة فيه اقل كمية وحين وصول الكمية اقل من هذا العدد او يساوية يقوم بنقل بيانات الصنف الي الشيت الاخر items.xlsm

تم حل المشكلة شكرا للجميع الحل كان في هذا الكود Private Sub UserForm_Initialize() With Me.ListBox1 .ColumnCount = 14 .RowSource = Empty Sheets("PURCHASES").Select .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 CommandButton2_Click() Application.ScreenUpdating = False Me.ListBox1.ColumnWidths = "100,100,100" ListBox1.RowSource = Empty ListBox1.Clear Sheets("suppliers").Select For Each f In Range("a2:a" & Range("a10000").End(xlUp).Row) If f Like textbo1 & "*" Then listed = ListBox1.ListCount ListBox1.AddItem ListBox1.List(listed, 0) = f ListBox1.List(listed, 2) = f.Offset(0, 2) ListBox1.List(listed, 3) = f.Offset(0, 3) End If Next Dim x As Double For i = 0 To ListBox1.ListCount - 1 x = x + ListBox1.List(i, 3) Next i Me.Label9.Visible = True Me.TextBox8.Visible = True TextBox8.Value = x Dim v As Double For Z = 0 To ListBox1.ListCount - 1 v = v + ListBox1.List(Z, 2) Next Z Me.Label8.Visible = True Me.TextBox7.Visible = True TextBox7.Value = v Application.ScreenUpdating = True End Sub شكرا للجميع والله الموفق لي واياكم واذا لم استفيد بمساعدة احد يكفيني ان ممكن احد يستفيد من هذا الكود شكرا