شرح الترحيل بالأكواد

**محمود_الشريف** · يناير 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

**عمرو_** · يناير 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 تمنع وقوع اى خطا فى الكود اذا كان هناك اى ملف اكسيل اخر مفتوح

بالتوفيق

**محمد ابو البـراء** · يناير 27, 2014

الاخ الحبيب / محود الشريف

الاستاذ الفاضل / عمرو

موضوع بالفعل مميز ويحتاجه الكثير

جزاكما الله خيراً..

أبو أنس80 · يناير 27, 2014

shwkran

توكل · يناير 27, 2014

شكراً لكل من الأخ محمود والأخ عمرو

**رجب جاويش** · يناير 27, 2014

الأخ الفاضل / محود الشريف

الأخ الفاضل / عمرو

موضوع بالفعل مميز ويحتاجه الكثير

جزاكما الله خيراً

**أم عبد الله** · يناير 27, 2014

الأستاذ الفاضل / محمود الشريف

الأستاذ / عمرو

السلام عليكم ورحمة الله وبركاته

جزاكم الله خيراً على هذا الموضوع المميز بالفعل يحتاجه الكثير منا. جعله الله في ميزان حسناتكم. لكم كل التحية والتقدير.

**ضاحي الغريب** · يناير 27, 2014

اخواني الأستاذ // محمودالشريف - الأستاذ / عمرو

السلام عليكم ورحمة الله وبركاته

بارك الله فيكما شرح جميل وميسر

اللهم تقبل منا ومنكم صالح الاعمال

تقبلوا تحياتي

**عادل ابوزيد** · يناير 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

**saad abed** · يناير 27, 2014

اخوانى

محمود الشريف

ابوحنين

نشكركم وجزاكم الله خيرا

بارك الله فيكم

اخى ابوحنين

يا ريت شرح مبسط لاستخدام المصفوفات فى هذا الكود

تحياتى للجميع

**محمود_الشريف** · يناير 27, 2014

إخوانى فى الله

الأستاذ الكبير / عمرو بارك الله فيكم وعلى إثراء الموضوع لتعم الفائدة

الأستاذ الحبيب / محمد ابو البراء بارك الله فيكم على مروركم الطيب

الأستاذ / shakwana بارك الله فيكم على مروركم الكريم

الأستاذ / توكل بارك الله فيكم على مروركم الكريم

أستاذى القدير / رجب جاويش بارك الله فيكم على مروركم الطيب

الأستاذة القديرة / أم عبد الله بارك الله فيكم وعلى دعواتكم الطيبة

أستاذى القدير / ضاحى الغريب بارك الله فيكم وعلى كلماتكم ودعواتكم الطيبة

الأستاذ / عادل أبو زيد بارك الله فيكم وبالنسبة لطلبكم نسأل الله عز وجل أن تكون هذه النواه لعمل متكامل

أستاذى القدير / أبو حنين بارك الله فيكم وعلى إثرائكم للموضوع بأكوادكم الرائعة السهل الممتنع

الأستاذ القدير / سعد عابد بارك الله فيكم على مروركم الكريم وبالنسبة لطلبكم إن شاء الرحمن سنتناول أمور الترحيل بالأكواد قدر المستطاع

وجزاكم رب العالمين عنى خير الجزاء

وتقبلوا منى وافر الإحترام والتقدير

محمد علي الطيب · يناير 28, 2014

السلام عليكم ورحمة الله وبركاته

شرح جميل بارك الله فيكم

**۩◊۩ أبو حنين ۩◊۩** · يناير 28, 2014

السلام عليكم ورحمه الله وبركاته

الاخ العزيز ...محمود_الشريف والاخ الحبيب ابو حنين

سلمت يداكم وجزاكم الله كل الخير ...

**أبو حنــــين** · يناير 28, 2014

أخي ابو حنين

**وليد فتحي** · يناير 28, 2014

الأستاذة الأفاضل / محمود الشريف - عمرو - أبو حنين

جزاكم الله خيراً وجعله في ميزان حسناتكم

**محمود_الشريف** · يناير 28, 2014

إخوانى فى الله

الأستاذ / محمد على الطيب

الأستاذ / ابو حنين

الأستاذ / وليد فتحى

بارك الله فيكم

وتقبلوا منى وافر الإحترام والتقدير

**أبو حنــــين** · يناير 29, 2014

أخي وليد فتحي

جزاكم الله خيرا

تم تعديل يناير 29, 2014 بواسطه أبو حنين

**أبو محمد عباس** · يناير 29, 2014

السلام عليكم ورحمة الله وبركاته

الاستاذ والاخ العزيز محمود الشريف جزاك الله خيرا

موضوع رائع وشرح اروع للتعديل عليه حسب الحاجة

وفقكم الله ورعاكم وزادكم من فضله علما وخيرا كثيرا

تقبلوا فائق احترامي وتقديري

**أبو محمد عباس** · يناير 29, 2014

السلام عليكم ورحمة الله وبركاته

الاخ العزيز عمرو جزاك الله خيرا

كود رائع زادك الله من فضله علما وخيرا كثيرا

تقبلوا فائق احترامي وتقديري

**أبو محمد عباس** · يناير 29, 2014

السلام عليكم ورحمة الله وبركاته

الاستاذ الكبير والاخ العزيز ابو حنين حفظكم الباري عز وجل ورعاكم

اعمالكم مميزه زادكم الله من فضله علما وخيرا كثيرا

تقبلوا فائق احترامي وتقديري

**أبو حنــــين** · يناير 29, 2014

أخي أبو محمد

جزاكم الله خيرا على المرور و الدعاء

و لك باضعافه ان شاء الله

حفظكم الله و رعاكم

alsalemsf · يناير 29, 2014

أهلاً استاذي ..

شكراً على جهودكم، استفسار بسيط قد يتعلق في مسألة الترحيل.

في الحقيقة، أملك ملف اكسل قمت بتسجيل جميع العملاء فيه، مع ايضاح آلية الدفعات وما الى ذلك، إلا أن المشكلة في عمل ورقة كشف الحساب للعميل المراد اصدار كشف له.

هل يمكن ذلك من خلال الترحيل؟

قمت بتحميل الملف والتجربة إلا أني لم اتمكن من ذلك، فما ارغب عمله الحقيقة، هو أن يتمكن البرنامج من ترحيل جميع المدخلات الى ملف كشف الحساب بشكل تلقائي عند تسجيلها مباشرةً في قاعدة البيانات.

لكم جزيل الشكر وخالص التحايا ..

**أبو حنــــين** · يناير 29, 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

لزيادة الفائده نرجو من احد العمالقه شرح الكود

تسجيل الدخول

شرح الترحيل بالأكواد

الردود الموصى بها

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information