محمود_الشريف قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 الساده / أعضاء المنتدى المحترمين السلام عليكم ورحمه الله وبركاته أقدم لكم طريقة مبسطة لشرح آلية الترحيل بالكود وقد إستخدمت كود مبسط لكى يكون سهل التعديل عليه حسب ما ترغبون وهذا الكود للترحيل مع مسح البيانات المدخله مع آلية الترقيم التلقائى الشرح في المثال المرفق ستجد ورقتا عمل " Invoice " " List" وسيتم إدخال البيانات في الورقه " Invoice " ثم بعد الإنتهاء نضغط على الزر لتنتقل في أماكن محدده بورقة العمل " List " ..* تعالوا نرى الكودكود: Sub MoveData() Dim EndRow As Long If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" Else EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count Sheets("List").Cells(EndRow + 1, 1).Value = EndRow Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value Sheets("List").Cells(EndRow + 1, 3).Value = Sheets("Invoice").Cells(3, 4).Value Sheets("List").Cells(EndRow + 1, 4).Value = Sheets("Invoice").Cells(5, 1).Value Sheets("List").Cells(EndRow + 1, 5).Value = Sheets("Invoice").Cells(6, 4).Value Sheets("List").Cells(EndRow + 1, 6).Value = Sheets("Invoice").Cells(8, 2).Value Sheets("List").Cells(EndRow + 1, 7).Value = Sheets("Invoice").Cells(8, 4).Value Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" End If End Sub * الكود السابق هو الخاص بعملية الترحيل من الورقه " Invoice " الي الورقه " List " ولكن ماذا يعني الكود وكيف نعدل فيه حسب الرغبه ؟* في الكود التالي وضعنا شرط على الخلايا التي يتم إدخال البيانات بها بالورقه "Invoice" بحيث تظهر رساله تفيد بأنه يجب التأكد من إدخال كافة البيانات مع العلم أنه يمكن الأستغناء عن بعض الخلايا أو كلها بحذف الشرط أو جزأ منهكود: If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" * وهنا سيبدأ البحث عن أول صف فارغ لنقل البيانات أليه مع الترقيم في العمود A كود: EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count * هنا سيقوم بنقل البيانات المدخله في الورقه "Invoice" في الخليه الموجوده في الصف الثالث - العمود الثاني الي الورقه " List " في الخليه الموجوده في العمود الثاني - الصف الأول كود: Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value * وهكذا ينطبق الكود السابق على باقي الخلايا المدخل بها البيانات الي أن نصل الي* هذا الكود يقوم بمسح البيانات المدخله بالورقه " Invoice" بعد نقلها للورقه " List "كود: Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents * بقي كود يظهر رسالة تأكيد بإنتهاء العمليه بنجاحكود: MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" أسأل الله العلى القدير أن أكون وفقت فى الشرح ومرفق نموذج للتطبيق العملى وتقبلوا منى وافر الإحترام والتقدير شرح الترحيل.rar 3 رابط هذا التعليق شارك More sharing options...
عمرو_ قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 اخى العزيز محمود الشريف جزاك الله خيرا موضوع ممتاز واهم ما يميزه البساطه فى الشرح و التنظيم المتقن بارك الله فيك ولاثراء الموضوع ,وافادة الاعضاء الجدد ورقه العمل داخل اى مصنف اكسيل هى عباره عن object اى كائن له خصائصه ولاعطاء شكل بسيط الى الاكواد نقوم تعريف ورقة العمل عند بداية الكود باسم مختصر عن طريق جملة set واستخدام هذا الاسم داخل الكود بدلا من كتابة اسم الورقه كل مره داخل الكود Sub MoveData() Set li = ThisWorkbook.Sheets("List") Set inv = ThisWorkbook.Sheets("Invoice") Dim EndRow As Long If inv.Range("B3").Value = "" Or inv.Range("D3").Value = "" Or inv.Range("a5").Value = "" Or inv.Range("D6").Value = "" Or inv.Range("B8").Value = "" Or inv.Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" Else EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count li.Cells(EndRow + 1, 1).Value = EndRow li.Cells(EndRow + 1, 2).Value = inv.Cells(3, 2).Value li.Cells(EndRow + 1, 3).Value = inv.Cells(3, 4).Value li.Cells(EndRow + 1, 4).Value = inv.Cells(5, 1).Value li.Cells(EndRow + 1, 5).Value = inv.Cells(6, 4).Value li.Cells(EndRow + 1, 6).Value = inv.Cells(8, 2).Value li.Cells(EndRow + 1, 7).Value = inv.Cells(8, 4).Value li.Range("B3,D3,A5:D5,D6,B8,D8").ClearContents MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" End If End Sub استخدام كلمة thisworkbook تمنع وقوع اى خطا فى الكود اذا كان هناك اى ملف اكسيل اخر مفتوح بالتوفيق 2 رابط هذا التعليق شارك More sharing options...
محمد ابو البـراء قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 الاخ الحبيب / محود الشريف الاستاذ الفاضل / عمرو موضوع بالفعل مميز ويحتاجه الكثير جزاكما الله خيراً.. رابط هذا التعليق شارك More sharing options...
أبو أنس80 قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 shwkran رابط هذا التعليق شارك More sharing options...
توكل قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 شكراً لكل من الأخ محمود والأخ عمرو رابط هذا التعليق شارك More sharing options...
رجب جاويش قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 الأخ الفاضل / محود الشريف الأخ الفاضل / عمرو موضوع بالفعل مميز ويحتاجه الكثير جزاكما الله خيراً رابط هذا التعليق شارك More sharing options...
أم عبد الله قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 الأستاذ الفاضل / محمود الشريف الأستاذ / عمرو السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً على هذا الموضوع المميز بالفعل يحتاجه الكثير منا. جعله الله في ميزان حسناتكم. لكم كل التحية والتقدير. رابط هذا التعليق شارك More sharing options...
ضاحي الغريب قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 اخواني الأستاذ // محمودالشريف - الأستاذ / عمرو السلام عليكم ورحمة الله وبركاته بارك الله فيكما شرح جميل وميسر اللهم تقبل منا ومنكم صالح الاعمال تقبلوا تحياتي رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 الاستاذ الفاضل محمود الشريف هذا الموضوع من اهم المواضيع التى ارى انها يجب ان يشارك فيها جميع الاساتذه بخبراتهم لعرض معظم الافكار التى يمكن استخدامها فى الترحيل فالترحيل ليس فى هذا الكود فقط او فى كود لاستاذ جليل اخر الترحيل يجب ان يدرس بمنظورين : الترحيل بالمعادلات والترحيل بالكود ومنه يمكن ان نشرح الترحيل من خلال فورم فهذا الموضوع يجب ان يكون نواه لموضوع كبير يشارك فيه جيمع الاساتذه ليستفيد الجميع بخبرات بعضهم البعض ارجو ان ينال هذا الاقتراح اعجابكم واعجاب الاساتذه الاجلاء ونبدأ فى هذا المشروع جعله الله فى ميزان حسناتكم ونفعكم به فى الدنيا والاخرة رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 و زيادة لما قدمه الاساتذة الكرام و لتعميم الفائدة و تعدد الحلول هذه طريقة أخر عسى ان يستفيد بها احد و استفيد انا من دعائه Sub MoveData() Dim EndRow As Long, Ary1 As Variant, Ary2 As Variant, i As Byte, ii As Byte, li As Worksheet, inv As Worksheet Set li = ThisWorkbook.Sheets("List") Set inv = ThisWorkbook.Sheets("Invoice") '----------------------------------------------------------------------- Ary1 = Array("B3", "D3", "A5", "D6", "B8", "D8") Ary2 = Array("B", "C", "D", "E", "F", "G") '----------------------------------------------------------------------- For i = 0 To UBound(Ary1) If inv.Range(Ary1(i)) = "" Then MsgBox "رحاءا تأكد من إدخال البيانات", vbExclamation, "خطأ" Exit Sub End If Next '----------------------------------------------------------------------- EndRow = li.Range("A1").CurrentRegion.Rows.Count + 1 For ii = 0 To UBound(Ary1) li.Range(Ary2(ii) & EndRow).Value = inv.Range(Ary1(ii)).Value li.Range("A" & EndRow) = EndRow - 1 inv.Range(Ary1(ii)) = "" Next MsgBox "تم ترحيل البيانات بنجاح", vbInformation, "رسالة تأكيد" End Sub رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر يناير 27, 2014 مشاركة قام بنشر يناير 27, 2014 اخوانى محمود الشريف ابوحنين نشكركم وجزاكم الله خيرا بارك الله فيكم اخى ابوحنين يا ريت شرح مبسط لاستخدام المصفوفات فى هذا الكود تحياتى للجميع رابط هذا التعليق شارك More sharing options...
محمود_الشريف قام بنشر يناير 27, 2014 الكاتب مشاركة قام بنشر يناير 27, 2014 إخوانى فى الله الأستاذ الكبير / عمرو بارك الله فيكم وعلى إثراء الموضوع لتعم الفائدة الأستاذ الحبيب / محمد ابو البراء بارك الله فيكم على مروركم الطيب الأستاذ / shakwana بارك الله فيكم على مروركم الكريم الأستاذ / توكل بارك الله فيكم على مروركم الكريم أستاذى القدير / رجب جاويش بارك الله فيكم على مروركم الطيب الأستاذة القديرة / أم عبد الله بارك الله فيكم وعلى دعواتكم الطيبة أستاذى القدير / ضاحى الغريب بارك الله فيكم وعلى كلماتكم ودعواتكم الطيبة الأستاذ / عادل أبو زيد بارك الله فيكم وبالنسبة لطلبكم نسأل الله عز وجل أن تكون هذه النواه لعمل متكامل أستاذى القدير / أبو حنين بارك الله فيكم وعلى إثرائكم للموضوع بأكوادكم الرائعة السهل الممتنع الأستاذ القدير / سعد عابد بارك الله فيكم على مروركم الكريم وبالنسبة لطلبكم إن شاء الرحمن سنتناول أمور الترحيل بالأكواد قدر المستطاع وجزاكم رب العالمين عنى خير الجزاء وتقبلوا منى وافر الإحترام والتقدير رابط هذا التعليق شارك More sharing options...
محمد علي الطيب قام بنشر يناير 28, 2014 مشاركة قام بنشر يناير 28, 2014 السلام عليكم ورحمة الله وبركاته شرح جميل بارك الله فيكم رابط هذا التعليق شارك More sharing options...
۩◊۩ أبو حنين ۩◊۩ قام بنشر يناير 28, 2014 مشاركة قام بنشر يناير 28, 2014 السلام عليكم ورحمه الله وبركاته الاخ العزيز ...محمود_الشريف والاخ الحبيب ابو حنين سلمت يداكم وجزاكم الله كل الخير ... رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر يناير 28, 2014 مشاركة قام بنشر يناير 28, 2014 أخي ابو حنين رابط هذا التعليق شارك More sharing options...
وليد فتحي قام بنشر يناير 28, 2014 مشاركة قام بنشر يناير 28, 2014 الأستاذة الأفاضل / محمود الشريف - عمرو - أبو حنين جزاكم الله خيراً وجعله في ميزان حسناتكم رابط هذا التعليق شارك More sharing options...
محمود_الشريف قام بنشر يناير 28, 2014 الكاتب مشاركة قام بنشر يناير 28, 2014 إخوانى فى الله الأستاذ / محمد على الطيب الأستاذ / ابو حنين الأستاذ / وليد فتحى بارك الله فيكم وتقبلوا منى وافر الإحترام والتقدير رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 (معدل) أخي وليد فتحي جزاكم الله خيرا تم تعديل يناير 29, 2014 بواسطه أبو حنين رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 السلام عليكم ورحمة الله وبركاته الاستاذ والاخ العزيز محمود الشريف جزاك الله خيرا موضوع رائع وشرح اروع للتعديل عليه حسب الحاجة وفقكم الله ورعاكم وزادكم من فضله علما وخيرا كثيرا تقبلوا فائق احترامي وتقديري رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 السلام عليكم ورحمة الله وبركاته الاخ العزيز عمرو جزاك الله خيرا كود رائع زادك الله من فضله علما وخيرا كثيرا تقبلوا فائق احترامي وتقديري رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 السلام عليكم ورحمة الله وبركاته الاستاذ الكبير والاخ العزيز ابو حنين حفظكم الباري عز وجل ورعاكم اعمالكم مميزه زادكم الله من فضله علما وخيرا كثيرا تقبلوا فائق احترامي وتقديري رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 أخي أبو محمد جزاكم الله خيرا على المرور و الدعاء و لك باضعافه ان شاء الله حفظكم الله و رعاكم رابط هذا التعليق شارك More sharing options...
alsalemsf قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 أهلاً استاذي .. شكراً على جهودكم، استفسار بسيط قد يتعلق في مسألة الترحيل. في الحقيقة، أملك ملف اكسل قمت بتسجيل جميع العملاء فيه، مع ايضاح آلية الدفعات وما الى ذلك، إلا أن المشكلة في عمل ورقة كشف الحساب للعميل المراد اصدار كشف له. هل يمكن ذلك من خلال الترحيل؟ قمت بتحميل الملف والتجربة إلا أني لم اتمكن من ذلك، فما ارغب عمله الحقيقة، هو أن يتمكن البرنامج من ترحيل جميع المدخلات الى ملف كشف الحساب بشكل تلقائي عند تسجيلها مباشرةً في قاعدة البيانات. لكم جزيل الشكر وخالص التحايا .. رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر يناير 29, 2014 مشاركة قام بنشر يناير 29, 2014 السلام عليكم ارفع ملفا للمنتدى تبين فيه المطلوب رابط هذا التعليق شارك More sharing options...
قصي قام بنشر يناير 30, 2014 مشاركة قام بنشر يناير 30, 2014 و زيادة لما قدمه الاساتذة الكرام و لتعميم الفائدة و تعدد الحلول هذه طريقة أخر عسى ان يستفيد بها احد و استفيد انا من دعائه Sub MoveData() Dim EndRow As Long, Ary1 As Variant, Ary2 As Variant, i As Byte, ii As Byte, li As Worksheet, inv As Worksheet Set li = ThisWorkbook.Sheets("List") Set inv = ThisWorkbook.Sheets("Invoice") '----------------------------------------------------------------------- Ary1 = Array("B3", "D3", "A5", "D6", "B8", "D8") Ary2 = Array("B", "C", "D", "E", "F", "G") '----------------------------------------------------------------------- For i = 0 To UBound(Ary1) If inv.Range(Ary1(i)) = "" Then MsgBox "رحاءا تأكد من إدخال البيانات", vbExclamation, "خطأ" Exit Sub End If Next '----------------------------------------------------------------------- EndRow = li.Range("A1").CurrentRegion.Rows.Count + 1 For ii = 0 To UBound(Ary1) li.Range(Ary2(ii) & EndRow).Value = inv.Range(Ary1(ii)).Value li.Range("A" & EndRow) = EndRow - 1 inv.Range(Ary1(ii)) = "" Next MsgBox "تم ترحيل البيانات بنجاح", vbInformation, "رسالة تأكيد" End Sub لزيادة الفائده نرجو من احد العمالقه شرح الكود 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان