إبراهيم ابوليله

السلام عليكم ورحمه الله وبركاته اخى واستاذنا بن عليه بارك الله فيك كود جميل ورائع والاهم انه يتسم بالبساطه نسأ الله ان يبارك لنا فى علمك تقبل تحياتى

السلام عليكم ورحمه الله وبركاته اخى طاهر تم عمل المطلوب تقبل تحياتى نموذج فاتوره بدون فورم.rar

السلام عليكم ورحمة الله وبركاته اخى احمد هل تقصد هكذا تقبل تحياتى النتيجه النهائيه.rar

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

اخى اولا لك منى دعوه طيبه لالتزام بقواعد النتدى ومنها ان تكون اسماء الظهزر بالغه العربيه --------------------------- ثانيا ارفق ملف للعمل عليه ---------- تقبل تحياتى

اخى عيسى -------- اذا كنت حصلت على ما تريد فاجعل الموضوع محلولا باختيار افضل اجابه ------------------- تقبل تحياتى

اخى عيسى ممكن ارفاق ملف للعمل عليه اوجرب الكود الاتى نفترض ان عدد الاعمد 3 بذلك يكون عرض العمود الاول 50 والثانى 100 والثالث 50 With ListBox1 .ColumnWidths = "50;100;50" end with

السلام عليكم ورحمه الله وبركاته اخى محمود جهد كبير ومعلومات جميله ومفيده بارك الله فيك نسأل الله ان تكون فى ميزان حسناتك ------------ تقبل تحياتى

اخى الريفى ------------------- السلام عليكم ورحمة الله وبركاته ----------------------------------- تم عمل المطلوب 1-استدعاء بيانات تم تسجيلها من قبل --------------------------------- جرب ادخال مستند التوريد رقم 9 وشاهد النتيجه بنفسك ---------------------------- وان شاء الله يتم عمل المطلوب الثانى وهو التعديل ----------- تقبل تحياتى العملاء.rar

اخى الريفى لاتقلق من ذلك ان شاء الله لن اتاخر فى الرد على الاسئله طالما استطيع الاجابه

اخى الريفى السلام عليكم ورحمه الله وبركاته -------------------------------- الخطأ كان فى تسلسل الكود الاتى If WS.Cells(9, 2).Value <> "" Then --------------------------------------- If WS.Cells(9 رقم 9 يشير الى السطر التاسع فى الفاتوره لذلك يجب عمل تسلس حتى نصل الى اخر سطر فى الادخال وهو السطر رقم 31 اى حتى يصبح الكود على الشكل الاتى If WS.Cells(31 استبدل الكود بالكود الاتى Sub hima_trs1() Application.ScreenUpdating = False Dim LR As Long Dim WS As Worksheet Dim WS1 As Worksheet Set WS = Worksheets("ÇáÑÆíÓíå") Set WS1 = Worksheets("ÇáíæãíÉ ÇáÚÇãå") LR = WS.Range("B100").End(xlUp).Row + 1 LR1 = WS1.Range("F10000").End(xlUp).Row + 1 LR2 = WS1.Range("B10000").End(xlUp).Row + 1 For r = 5 To LR1 If WS1.Cells(r, 4) = WS.Range("D5") Then MsgBox "Êã ÊÓÌíá ãÓÊäÏ ÇáÊæÑíÏ ÓÇÈÞÇ": Exit Sub Next WS.Range("B9:Z" & LR).Copy WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues If WS.Cells(9, 2).Value <> "" Then WS1.Cells(LR2, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(10, 2).Value <> "" Then WS1.Cells(LR2 + 1, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 1, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 1, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 1, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(11, 2).Value <> "" Then WS1.Cells(LR2 + 2, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 2, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 2, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 2, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(12, 2).Value <> "" Then WS1.Cells(LR2 + 3, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 3, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 3, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 3, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(13, 2).Value <> "" Then WS1.Cells(LR2 + 4, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 4, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 4, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 4, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(14, 2).Value <> "" Then WS1.Cells(LR2 + 5, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 5, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 5, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 5, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(15, 2).Value <> "" Then WS1.Cells(LR2 + 6, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 6, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 6, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 6, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(16, 2).Value <> "" Then WS1.Cells(LR2 + 7, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 7, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 7, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 7, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(17, 2).Value <> "" Then WS1.Cells(LR2 + 8, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 8, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 8, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 8, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(18, 2).Value <> "" Then WS1.Cells(LR2 + 9, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 9, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 9, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 9, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(19, 2).Value <> "" Then WS1.Cells(LR2 + 10, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 10, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 10, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 10, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(20, 2).Value <> "" Then WS1.Cells(LR2 + 11, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 11, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 11, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 11, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(21, 2).Value <> "" Then WS1.Cells(LR2 + 12, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 12, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 12, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 12, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(22, 2).Value <> "" Then WS1.Cells(LR2 + 13, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 13, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 13, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 13, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(23, 2).Value <> "" Then WS1.Cells(LR2 + 14, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 14, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 14, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 14, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(24, 2).Value <> "" Then WS1.Cells(LR2 + 15, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 15, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 15, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 15, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(25, 2).Value <> "" Then WS1.Cells(LR2 + 16, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 16, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 16, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 16, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(26, 2).Value <> "" Then WS1.Cells(LR2 + 17, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 17, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 17, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 17, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(27, 2).Value <> "" Then WS1.Cells(LR2 + 18, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 18, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 18, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 18, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(28, 2).Value <> "" Then WS1.Cells(LR2 + 19, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 19, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 19, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 19, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(29, 2).Value <> "" Then WS1.Cells(LR2 + 20, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 20, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 20, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 20, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(30, 2).Value <> "" Then WS1.Cells(LR2 + 21, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 21, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 21, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 21, 5).Value = WS.Cells(6, 4).Value End If If WS.Cells(31, 2).Value <> "" Then WS1.Cells(LR2 + 22, 2).Value = WS.Cells(3, 4).Value WS1.Cells(LR2 + 22, 3).Value = WS.Cells(4, 4).Value WS1.Cells(LR2 + 22, 4).Value = WS.Cells(5, 4).Value WS1.Cells(LR2 + 22, 5).Value = WS.Cells(6, 4).Value End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتى

الاخوه الافاضل السلام عليكم ورحمه الله وبركاته ---------------------------------- فى هذا الشيت قمت بعمل كود يقوم بتسديد الفواتير -------- ولكنى اريد كود يكون اخف واسرع ------- حيث ان هذا الكود فى الملف الاصلى يأخذ حوالى 42ثانيه لتنفيذ المطلوب ------------- وانا اريد تقليص هذه المده لانه فى الطبيعى لن يكون لدى 31 فاتوره فقط ولكن قد يصل العدد الى 400 فاتوره او اكثر -------------- ارجو المساعده ان امكن تسديد فواتير.rar

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

اخى سليم اشكرك على الاهتمام ولكن ماذال الكود لاياتى بما اريده وقد وضعت فيديو يوضح ما اريده ارجو مشاهده الفيديو h.rar

اخى طاهر السلام عليكم ورحمه الله وبركاته بالفعل ايقنت بعد رفع الفاتوره ان بها هذه المشاكل ولم يكن لدى الوقت للتعديل ان اشاء الله سوف يتم التعديل فى الوقت القريب ثم يتم عمل المطوب الخاص بوضع حد ادنى لترحيل الفاتوره تقبل تحاتى

اخى عمرو لا شكر على واجب فواجبى ان اقوم بمساعده من يحتاج طالما توفرت لديا المعرفه واسأل الله ان يجعلها خالصه لوجه الكريم

اخى سليم اسأل الله ان يوفققط فى عمل ذلك

اخى الريفى ان شاء الله يتم عمل المطلوب تقبل تحياتى

اخى عمرو اشكرك على تلبيه طلبى وللعلم كلنا هنا لدينا هف واحد وهو الارتفاع بشأن هذا المنتدى مره اخرى اشكرك على سرعة الاستجابه وتغير الاسم الى اللغه العربيه بارك الله فيك ----------------------------------------------------------------- ام بالنسبه لظهور الارقام بالسالب فارجو ارفاق ملف به المشكله للعمل عليه وان اشاء الله يتم المعالجه -------------------------------------------------------------------- تقبل تحايتى

اخى ممكن توضيح المطلوب اكثر حتى يتسنى لنا مساعدتك تقبل تحياتى

اخى الريفى السلام عليكم ورحمة الله وبركاته تم اضافة كود عدم التكرار جرب واخبرنى تقبل تحياتى العملاء.rar

اخى الريفى ان شاء الله يتم عمل المطلوب تقبل تحياتى

اخى الريفى ماذا تقصد بعدم تكرار الترحيل اى عمود يبنى عليه عدم التكرار

اخى عمرو اولا يجب عليك الاتزام بقواعد المنتدى ومنها ان تكون اسماء الظهور باللغه العربيه لذلك ادعوك اخى لتغير الاسم الى اللغه العربيه بارك الله فيك ثانيا تم عمل المطلوب تقبل تحياتى حساب العمر.rar

اخى رجب نحمد الله على تواجدك معنا ونسأل الله لك الصحه والعافيه والا يحرمنا من امثالكم