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

[محمود_الشريف]

الساده / أعضاء المنتدى   المحترمين

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

أقدم لكم طريقة مبسطة لشرح آلية الترحيل بالكود

وقد إستخدمت كود مبسط لكى يكون سهل التعديل عليه

حسب ما ترغبون

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

 

الشرح

 

في المثال المرفق ستجد ورقتا عمل " 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

[عمرو_]

اخى العزيز محمود الشريف

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

موضوع ممتاز واهم ما يميزه البساطه فى الشرح و التنظيم المتقن

بارك الله فيك

ولاثراء الموضوع ,وافادة الاعضاء الجدد

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

 

بالتوفيق

 

 

[محمد ابو البـراء]

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

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

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

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

[أبو أنس80]

shwkran

[توكل]

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

[رجب جاويش]

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

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

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

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

[أم عبد الله]

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

 

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

 

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

 

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

[ضاحي الغريب]

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

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

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

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

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

[عادل ابوزيد]

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

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

فالترحيل ليس فى هذا الكود فقط او فى كود لاستاذ جليل اخر

الترحيل يجب ان يدرس بمنظورين : الترحيل بالمعادلات    والترحيل بالكود ومنه يمكن ان نشرح الترحيل من خلال فورم

فهذا الموضوع يجب ان يكون نواه لموضوع كبير يشارك فيه جيمع الاساتذه ليستفيد الجميع بخبرات بعضهم البعض

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

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

[أبو حنــــين]

 

و زيادة لما قدمه الاساتذة الكرام

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

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]

اخوانى

محمود الشريف

ابوحنين

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

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

اخى ابوحنين

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

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

[محمود_الشريف]

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

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

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

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

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

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

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

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

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

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

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

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

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

[محمد علي الطيب]

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

 

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

[۩◊۩ أبو حنين ۩◊۩]

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

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

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

[أبو حنــــين]

أخي    ابو حنين

 

[وليد فتحي]

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

 

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

[محمود_الشريف]

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

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

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

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

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

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

[أبو حنــــين]

أخي    وليد فتحي

 

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

 

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

[أبو محمد عباس]

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

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

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

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

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

[أبو محمد عباس]

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

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

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

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

[أبو محمد عباس]

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

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

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

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

[أبو حنــــين]

أخي    أبو محمد

 

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

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

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

[alsalemsf]

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

 

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

 

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

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

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

 

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

[أبو حنــــين]

السلام عليكم

ارفع ملفا للمنتدى تبين  فيه المطلوب

[قصي]

 

 

و زيادة لما قدمه الاساتذة الكرام

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

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

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