أبو عبد الملك السوفي قام بنشر ديسمبر 22, 2017 مشاركة قام بنشر ديسمبر 22, 2017 (معدل) السلام عليكم هاته المرة الرابعة التي اطرح الموضوع ولم اجد توجيه او مساعده اعذروني فالامر يتعلق باموال الناس المطلوب هو تعديل الكود Sub Tarheel() 'ÞÑÇÁÉ ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí Dim d(19) d(1) = [g6]: d(2) = [g2]: d(3) = [g3]: d(4) = [g4]: d(5) = [b8]: d(6) = [g8]: d(7) = [C13]: d(8) = [f13]: d(9) = [C18]: d(10) = [f19]: d(11) = [C20]: d(12) = [b23]: d(13) = [B26]: d(14) = [c26]: d(15) = [B27]: d(16) = [c27]: d(17) = [b28]: d(18) = [c28]: d(19) = [c30] ' Check if this Invoice is exist With Sheets("total") LR = .[b10000].End(xlUp).Row For r = 4 To LR x = .Cells(r, 2).Value If x = [g6] Then GoTo 10 ' *** Found @ r (Row)*** Next r GoTo 30 ' NOT Found 10 MsgBox ("ÇáÝÇÊæÑÉ ãæÌæÏÉ ãä ÞÈá" & Chr(10) & "ÓíÊã ÍÐÝåÇ ãä æÑÞÉ ÇáÈíÇäÇÊ æäÞáåÇ ãßÇä ÇáÞÏíãÉ") If r <> LR Then n_LR = .Cells(r, 2).End(xlDown).Row - 1: GoTo 20 n_LR = .[b10000].End(xlUp).Row 20 .Range("B" & r & ":G" & n_LR).EntireRow.Delete Shift:=xlUp 30 'äÞá ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí ááæÑÞÉ ÏÇÊÇ DR = .[b10000].End(xlUp).Row + 1 'ÂÎÑ ÕÝ ÈíÇäÇÊ ÌÇåÒ áÇÓÊáÇã ÈíÇäÇÊ ÌÏíÏÉ ÈÇáæÑÞÉ ÏÇÊÇ For i = 1 To 19 .Cells(DR, i + 1) = d(i) Next i End With LR = [E31].End(xlUp).Row 'ÞÑÇÁÉ æäÞá ÇáÈíÇäÇÊ ÇáÃÑÈÚÉ ÇáÃÎíÑÉ Sheets("mokalassa").Select Reply = MsgBox("Êã ÊÑÍíá ÇáÝÇÊæÑÉ ÈÍãÏ Çááå" & Chr(10) & "åá ÊÑíÏ ãÓÍ ÇáÈíÇäÇÊ ãäåÇ", vbYesNo) If Reply <> 6 Then Exit Sub Range("g2") = [g3] Range("g3") = "=NOW()" Range("g4") = "=IF(HOUR(R[-1]C)>15,""ÇáãÓÇÆíÉ"",""ÇáÕÈÇÍíÉ"")" Range("b8:e8").ClearContents Range("g8").ClearContents Range("c13:d13").ClearContents Range("f13:g13").ClearContents Range("c18:d18").ClearContents Range("f19:g19").ClearContents Range("c20:d20").ClearContents [g6] = [g6] + 1 Range("b26:b28").ClearContents Range("c26:g26").ClearContents Range("c27:g27").ClearContents Range("c28:g28").ClearContents Range("c30:d30") = "=IF(R[-10]C="""","""",(R[-2]C[-1]+R[-3]C[-1]+R[-4]C[-1]+R[-10]C)-(R[-12]C+R[-17]C))" Range("b23:c23") = "=IF(R[-3]C[1]="""","""",R[-3]C[1]-(R[-5]C[1]+R[-10]C[1]))" End Sub فعند الرحيل اذا كان رقم الاستمارة موجود من قبل في صفحة total فانه يرحل الى نفس السطر وليس الى اخر سطر واضن ان الجزئية التاليه هي المقصودة بالتعديل 10 MsgBox ("الفاتورة موجودة من قبل" & Chr(10) & "سيتم حذفها من وقة البيانت ونقلها من مكانها القديم") If r <> LR Then n_LR = .Cells(r, 2).End(xlDown).Row - 1: GoTo 20 n_LR = .[b10000].End(xlUp).Row 20 .Range("B" & r & ":G" & n_LR).EntireRow.Delete Shift:=xlUp برنامج مركز شمس للتسوق تحت التعديل.rar تم تعديل ديسمبر 22, 2017 بواسطه أبو عبد الملك السوفي رابط هذا التعليق شارك More sharing options...
أبو عبد الملك السوفي قام بنشر ديسمبر 23, 2017 الكاتب مشاركة قام بنشر ديسمبر 23, 2017 للرفع بورك فيكم رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر ديسمبر 23, 2017 مشاركة قام بنشر ديسمبر 23, 2017 السلام عليكم أخي الكريم، لقد حاولت في الملف من أول موضوع لك في المنتدى ولم أجد الفكرة ولا زلت أحاول... أودّ أن أعرف لماذا تريد أن ترحّل البيانات إلى نفس مكانها في حالة وجودها ؟ هل يمكن القيام بمسحها دون ترحيلها (وأقصد مسح البيانات الموجودة مسبقا في شيت Total)؟ أخوك بن علية رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر ديسمبر 23, 2017 مشاركة قام بنشر ديسمبر 23, 2017 السلام عليكم ورحمة الله أخي الكريم، جرب الملف المرفق لعل فيه ما تريد... بن علية حاجي برنامج مركز شمس للتسوق تحت التعديل.rar رابط هذا التعليق شارك More sharing options...
أبو عبد الملك السوفي قام بنشر ديسمبر 23, 2017 الكاتب مشاركة قام بنشر ديسمبر 23, 2017 (معدل) جزاك الله خيرا استاذحاجي ونفع بك الهدف من الترحيل الى نفس السطر لان الاستمارة تملأ على مرحلتين المرحلة الاولة تملأ الييانات الاولى في الاستمارة ثم ترحل الى total اما المرحلة الثانية فيتم استدعاء الاستمارة واكمال المعلومات المتبيقة ثم ترحيلها لذا يجب ان تعدل في نفس السطر ولا يتغير مكانها والملف الاخير لم يفي بالغرض فهو ينقل الاستمارة المعدلة الى السطر ما قبل الاخير اي انه يحذف السطر الاخير وهو ليس المطلوب منذ 3 ايام او اكثر وانا احاول في تلك الجزئيه في الكود ولم انجح اخي سابعث لك الملف الاصلي الذي اخذت منه الكود فهو شغال وهو من اعداد الاستاذ محمود لعلك تفهم الية عمل الكود فاتورة جديدة6.rar تم تعديل ديسمبر 23, 2017 بواسطه أبو عبد الملك السوفي رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر ديسمبر 23, 2017 مشاركة قام بنشر ديسمبر 23, 2017 السلام عليكم ورحمة الله ألق نظرة على الملف المرفق وإن شاء الله تفي التعديلات على الكود بالغرض المطلوب... بن علية حاجي برنامج مركز شمس للتسوق تحت التعديل.rar 1 رابط هذا التعليق شارك More sharing options...
أبو عبد الملك السوفي قام بنشر ديسمبر 23, 2017 الكاتب مشاركة قام بنشر ديسمبر 23, 2017 تمام فرجت عني كربه اسال الله ان يفرج عنك كربة من كرب يوم القيامه هذا هو المطلوب تماما.... اسال الله لك الجنه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان