اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

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

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

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

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

حسب ما ترغبون

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

 

الشرح

 

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

  • Like 3
رابط هذا التعليق
شارك

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

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

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

بارك الله فيك

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

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

 

 

  • Like 2
رابط هذا التعليق
شارك

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

 

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

 

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

 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

931598431.gif

 

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

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

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

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

اخوانى

محمود الشريف

ابوحنين

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

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

اخى ابوحنين

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 

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

 

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

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

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

 

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

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

 

931598431.gif

 

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information