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

اهداء الى المنتدى--شرح كيفية عمل فاتوره على الكسيل بدون فورم

إبراهيم ابوليله

بواسطه إبراهيم ابوليله
في منتدى الاكسيل Excel

 مشاركة

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

إبراهيم ابوليله

إبراهيم ابوليله

قام بنشر
  • الكاتب
قام بنشر

بسم الله الرحمن الرحيم

والصلاة والسلام على اشرف المرسلين

سيدنا محمد صلى الله عليه وسلم

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

وبناء على طلب بعض الاخوه فى شرح كيفيه عمل النموذج

وتلبية لرغباتهم

نتناول طريقه عمل النموذج

ونظرا لضيق الوقت

ان شاء الله يتم تناول درس يوميا على الاقل حتى الانتهاء بإذن الله

..........................................................................

الاخوه الافاضل

الحمد لله فقد انتهينا من شرح الدرس

الاول وهو عباره عن ثلاثة دروس تمهيديه

وهى

اولا--تصميم الفاتوره

ثانيا--انشاء شيت به الاكواد المساعده

ثالثا--انشاء شيت لتجميع بيانات الفواتير المسجله

---------------------------------------------------

الان نبدأ فى شرح الدرس الثانى

وقد انتهينا سابقان من تناول

الدرس الثانى ( أ )  الكود الاول--كود يقوم بعمل تسلسل لرقم الفاتوره

الدرس الثانى ( ب )  الكود الثانى--كود يقوم بعمل تسلسل لبيانات الفاتوره

الدرس الثانى ( ج )  كود الثالث--يقوم باحضار بيانات العميل عند كتابة الكود الخاص بالعميل

الدرس الثانى ( ح )  الكود الرابع---كود يقوم باحضار بيانات الصنف عند كتابة الكود الخاص بالصنف   

 

الان نتناول شرح درس جديد

كان المفرروض ان يتم اعطاءه رقم خاص به

لكن اعزرونى فقد نسيت

لذلك سوف يتم الحاقه على الدرس الثانى (ح)

تابع الدرس الثانى ( ح )كود يقوم باستخراج القيمه الخاصه بكل صنف ثم استخراج اجمالى قيمة الفاتوره

اولا-استخراج القيمه الخاصه بكل صنف

  وهنا سوف نتعرف على كيفية وضع كود يكون من وظيفته استخراج قيمة كل صنف وذلك عن طريق

ضرب الكميه الخاصه بكل صنف فى السعر الخاص به

فمثلا بالنظر الى الفاتوره سنجد اننا نريد ان نجعل القيم التى توجد فى العمود h بداية من h16:h37

ان تكون عباره عن قيمة الخلايا من f16:f37 فى الخلايا من G16:G37

zVoe0a.jpg

وكما هو وضح من الصوره ان الخليه f16 بها بيانات الا وهو الرقم 1 وان الخليه G16

بها بيانات الا وهى الرقم 2  ومع ذلك نجد ان الخليه G16 مازالت فارغه

وما نريده ان تصبح قيمة الخليه G16 =2

عن طريق ضرب الخليه H16 (قيمتها الرقم 1) فى قيمة الخليه F16(قيمتها الرقم 2)

اى 1*2=2

وهكذا

وننبه الى ان الكود سوف يتم وضعه فى حدث الورقه

الان دعونا نضع الكود داخل محرر الاكواد كما فى الصوره

e6D028.jpg

الان وبعد ان قمنا بادخال الكود فى محرر الاكواد

نقوم بكتابة بعض الارقام فى الخلايا من f16:f20  سنجد ان الخلايا من g16:g20

قد امتلئت بالقيمه كما فى الصوره

CeYEIo.jpg

ثانيا-استخراج اجمالى الفاتوره

هذا الكود ايضا يوضع فى حدث الورقه

دعونا نلقى نظره على شكل الفاتوره وخصوصا الخليه i39 الخاصه باجمالى الفاتوره

وذلك قبل كتابة الكود سنجد انها فارغه كما فى الصوره

hbe9BO.jpg

الان دعونا نضع الكود داخل محرر الاكواد كما فى الصوره

وهنا سنلاحظ ان الكود سوف يكون عباره عن سطر بسيط يتم كتابة مع الكود الخاص

باستخراج قيمة كل صنف

ElTGFI.jpg

الان وبعد ان قمنا بكتابة السطر الخاص بالكود

نقوم بالقاء نظره على شكل الخليه i39 سنجد انها اصبحت مملوءه بالارقام التى هى عباره

عن ناتج جمع قيمة الاصناف الموجوده بالفاتوره

9NZV3I.jpg

شرح الكود

اولا-استخراج القيمه الخاصه بكل صنف

If Not Intersect(Target, [f16:f37]) Is Nothing Then

تحديد نطاق ادخال البيانات

If Target.Value <> "" Then

فى حالة ان يكون النطاق او احد خلايا النطاق غير فارغه يتم الاتى

Target.Offset(0, 2) = Target.Offset(0, 0) * Target.Offset(0, 1)

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

الخليه التى تلى النطاق فى نفس السطر وفى نفس العمود اى خليه النطاق نفسها مضروبه فى قيمة

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

اى انه لو ان الخليه التى تم ادخال البيانات بها هى

الخليه f16 اذا

 Target.Offset(0, 2)

سيكون عباره عن الخليه   h16 

Target.Offset(0, 0)

وهذا السطر عباره عن الخليه f16

Target.Offset(0, 1)

وهذا السطر عباره عن الخليه g16

وهكذا بالنسبه لباقى الاسطر المتشابهه

ثانيا-استخراج اجمالى الفاتوره

Range("i39") = Application.Sum(Range("h16:h37"))

هنا يتم استخدام المعادله sum

لجمع الارقام الموجوده فى النطاق من h16:h37

 

............................................................................................................................................................................................................................

الان نقوم بتجربه الملف المرفق لرؤيه عمل الكود على حده

 

شاهد  المرفق    4-EXCEL

-----------------------------------------------------------------------------------

الان قد انتهينا من شرح

تابع الدرس الثانى ( ح )كود يقوم باستخراج القيمه الخاصه بكل صنف ثم استخراج اجمالى قيمة الفاتوره

اتمنى ان اكون قد وفقت فى الشرح

 

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

4-EXCEL.rar

  • الردود 115
  • Created
  • اخر رد

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

إبراهيم ابوليله
إبراهيم ابوليله

بسم الله الرحمن الرحيم والصلاة والسلام على اشرف خلق الله سيدنا محمد صلى الله عليه وسلم   اخوانى الافاضل تم سابقا عمل نموذج فاتوره بدون فورم على الرابط الاتى http://www.officena.net/ib/index.p

إبراهيم ابوليله
إبراهيم ابوليله

بسم الله الرحمن الرحيم والصلاة والسلام على اشرف المرسلين سيدنا محمد صلى الله عليه وسلم لقد قدمت سابقا نموذج فاتوره على الاكسيل بدون فورم وبناء على طلب بعض الاخوه فى شرح كيفيه عمل النموذج وتلبية ل

إبراهيم ابوليله
إبراهيم ابوليله

بسم الله الرحمن الرحيم والصلاة والسلام على اشرف المرسلين سيدنا محمد صلى الله عليه وسلم لقد قدمت سابقا نموذج فاتوره على الاكسيل بدون فورم وبناء على طلب بعض الاخوه فى شرح كيفيه عمل النموذج وتلبية ل

Posted Images

KHMB

KHMB

قام بنشر
قام بنشر

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

اخينا واستاذنا / إبراهيم أبو ليله يحفظك الله

 

نحن منتظرين تكملة الدروس والمتعلقة بموضوع : شرح كيفية عمل فاتورة علي الاكسل بدون فورم.

وبخاصة حفظ الفاتورة في بيانات الفاتورة وطباعتها.

 

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

من الأفضل ان تنهي الدرس انتظرونا في الدرس القادم او انتهى عند النهاية لكي نعطيك ننتظرك ونترك لك الوقت الكافي

جزاك الله خير 

إبراهيم ابوليله

إبراهيم ابوليله

قام بنشر
  • الكاتب
قام بنشر

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

اخينا واستاذنا / إبراهيم أبو ليله يحفظك الله

 

نحن منتظرين تكملة الدروس والمتعلقة بموضوع : شرح كيفية عمل فاتورة علي الاكسل بدون فورم.

وبخاصة حفظ الفاتورة في بيانات الفاتورة وطباعتها.

 

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

من الأفضل ان تنهي الدرس انتظرونا في الدرس القادم او انتهى عند النهاية لكي نعطيك ننتظرك ونترك لك الوقت الكافي

جزاك الله خير 

اخى kmb

ارجو التماس العزر لى

ولكنى بالفعل هذه الفتره مشغول جدا

ولكن لم تنتهى الدروس طبعا

فمازال هناك الكثير

تقبل تحياتى

KHMB

KHMB

قام بنشر
قام بنشر

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

 

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

 

وبالبحث هناك لك موضوع آخر بنفس الخصوص تحت الاسم حركة ترحيل وتابعتة فقد ابدعت جدا وصابرت حتى شبع الطالب

 

انا مقدر انشغالك ولكن للتأكد من عدم انتهى الموضوع وتذكير لكى لاينطوي الموضوع بالنسيان او أحيانا الملل اعانك الله وقدرك لكل خير

لاتنسى الملاحظة وهي اما انتظرونا او يتبع ألأي ان تصل النهاية فتنهي انتهــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــى لكي نعرف

جزاك الله خير

إبراهيم ابوليله

إبراهيم ابوليله

قام بنشر
  • الكاتب
قام بنشر

بسم الله الرحمن الرحيم

والصلاة والسلام على اشرف المرسلين

سيدنا محمد صلى الله عليه وسلم

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

وبناء على طلب بعض الاخوه فى شرح كيفيه عمل النموذج

وتلبية لرغباتهم

نتناول طريقه عمل النموذج

ونظرا لضيق الوقت

ان شاء الله يتم تناول درس يوميا على الاقل حتى الانتهاء بإذن الله

..........................................................................

الاخوه الافاضل

الحمد لله فقد انتهينا من شرح الدرس

الاول وهو عباره عن ثلاثة دروس تمهيديه

وهى

اولا--تصميم الفاتوره

ثانيا--انشاء شيت به الاكواد المساعده

ثالثا--انشاء شيت لتجميع بيانات الفواتير المسجله

---------------------------------------------------

الان نبدأ فى شرح الدرس الثانى

وقد انتهينا سابقان من تناول

الدرس الثانى ( أ )  الكود الاول--كود يقوم بعمل تسلسل لرقم الفاتوره

الدرس الثانى ( ب )  الكود الثانى--كود يقوم بعمل تسلسل لبيانات الفاتوره

الدرس الثانى ( ج )  كود الثالث--يقوم باحضار بيانات العميل عند كتابة الكود الخاص بالعميل

الدرس الثانى ( ح )  الكود الرابع---كود يقوم باحضار بيانات الصنف عند كتابة الكود الخاص بالصنف   

تابع الدرس الثانى ( ح )كود يقوم باستخراج القيمه الخاصه بكل صنف ثم استخراج اجمالى قيمة الفاتوره

 

الان نتناول شرح

الدرس الثانى ( خ )  الكود الخامس---كود يقوم بترحيل بيانات الفاتوره الى شيت invoice date

 

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

وسوف يتم تسميتها ب hima_trs_

طبعا اكود الترحيل كتيره جدا

وان شاء الله يتم التطرق الى اكثر من كود حتى يتسنى للجميع الالمام باغلب الاكوادالتى تستخدم فى الترحيل

ولكن دعونا نبدأ بالكود البسيط جدا ولكن يعيبه ان طويل جدا

الكود طبعا هيبقى طويل حبه وذلك لاننا لو نظرنا الى الفاتوره سنجد ان عدد صفوفها عبارهعن 22 صف

لذلك الكود يبفى عباره عن 22 شرط كل شرط هيكون مرتبط بصف من صفوف الفاتوره

وطبعا شكل الكود النهائى هيكون بالشكل الاتى

Sub hima_trs()
Application.ScreenUpdating = False
Dim LR As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("INVOICE")
Set WS1 = Worksheets("INVOICE DATA")
LR = WS1.Range("e10000").End(xlUp).Row + 1
LR1 = WS1.Range("c10000").End(xlUp).Row + 1
    For r = 3 To LR1
        If WS1.Cells(r, 3) = WS.Range("f2") Then MsgBox "This invoice already exist, No shift will done": Exit Sub
    Next
            If WS.Range("d4").Value = "" Then MsgBox "enter invoice date": Exit Sub
 If WS.Cells(16, 3).Value = "" Then MsgBox "حد ادنى صف واحد لكى يسمح للفاتورة بالترحيل ": Exit Sub

If WS.Cells(16, 3).Value <> "" Then
WS1.Cells(LR, 2) = WS.Range("d4").Value
WS1.Cells(LR, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR, 3) = WS.Range("f2").Value
WS1.Cells(LR, 4) = WS.Range("f6").Value
WS1.Cells(LR, 5) = WS.Range("d8")
WS1.Cells(LR, 6) = WS.Range("h8")
WS1.Cells(LR, 7) = WS.Range("d10")
WS1.Cells(LR, 8) = WS.Range("d12")
WS1.Cells(LR, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR, 9) = WS.Range("c16").Offset(0, 0).Value
WS1.Cells(LR, 10) = WS.Range("c16").Offset(0, 1).Value
WS1.Cells(LR, 11) = WS.Range("c16").Offset(0, 2).Value
WS1.Cells(LR, 12) = WS.Range("c16").Offset(0, 3).Value
WS1.Cells(LR, 13) = WS.Range("c16").Offset(0, 4).Value
WS1.Cells(LR, 14) = WS.Range("c16").Offset(0, 5).Value
WS1.Cells(LR, 15) = WS.Range("c16").Offset(0, 6).Value
End If
If WS.Cells(17, 3).Value <> "" Then
WS1.Cells(LR + 1, 2) = WS.Range("d4").Value
WS1.Cells(LR + 1, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 1, 3) = WS.Range("f2").Value
WS1.Cells(LR + 1, 4) = WS.Range("f6").Value
WS1.Cells(LR + 1, 5) = WS.Range("d8")
WS1.Cells(LR + 1, 6) = WS.Range("h8")
WS1.Cells(LR + 1, 7) = WS.Range("d10")
WS1.Cells(LR + 1, 8) = WS.Range("d12")
WS1.Cells(LR + 1, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 1, 9) = WS.Range("c16").Offset(1, 0).Value
WS1.Cells(LR + 1, 10) = WS.Range("c16").Offset(1, 1).Value
WS1.Cells(LR + 1, 11) = WS.Range("c16").Offset(1, 2).Value
WS1.Cells(LR + 1, 12) = WS.Range("c16").Offset(1, 3).Value
WS1.Cells(LR + 1, 13) = WS.Range("c16").Offset(1, 4).Value
WS1.Cells(LR + 1, 14) = WS.Range("c16").Offset(1, 5).Value
WS1.Cells(LR + 1, 15) = WS.Range("c16").Offset(1, 6).Value
End If
If WS.Cells(18, 3).Value <> "" Then
WS1.Cells(LR + 2, 2) = WS.Range("d4").Value
WS1.Cells(LR + 2, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 2, 3) = WS.Range("f2").Value
WS1.Cells(LR + 2, 4) = WS.Range("f6").Value
WS1.Cells(LR + 2, 5) = WS.Range("d8")
WS1.Cells(LR + 2, 6) = WS.Range("h8")
WS1.Cells(LR + 2, 7) = WS.Range("d10")
WS1.Cells(LR + 2, 8) = WS.Range("d12")
WS1.Cells(LR + 2, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 2, 9) = WS.Range("c16").Offset(2, 0).Value
WS1.Cells(LR + 2, 10) = WS.Range("c16").Offset(2, 1).Value
WS1.Cells(LR + 2, 11) = WS.Range("c16").Offset(2, 2).Value
WS1.Cells(LR + 2, 12) = WS.Range("c16").Offset(2, 3).Value
WS1.Cells(LR + 2, 13) = WS.Range("c16").Offset(2, 4).Value
WS1.Cells(LR + 2, 14) = WS.Range("c16").Offset(2, 5).Value
WS1.Cells(LR + 2, 15) = WS.Range("c16").Offset(2, 6).Value
End If
If WS.Cells(19, 3).Value <> "" Then
WS1.Cells(LR + 3, 2) = WS.Range("d4").Value
WS1.Cells(LR + 3, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 3, 3) = WS.Range("f2").Value
WS1.Cells(LR + 3, 4) = WS.Range("f6").Value
WS1.Cells(LR + 3, 5) = WS.Range("d8")
WS1.Cells(LR + 3, 6) = WS.Range("h8")
WS1.Cells(LR + 3, 7) = WS.Range("d10")
WS1.Cells(LR + 3, 8) = WS.Range("d12")
WS1.Cells(LR + 3, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 3, 9) = WS.Range("c16").Offset(3, 0).Value
WS1.Cells(LR + 3, 10) = WS.Range("c16").Offset(3, 1).Value
WS1.Cells(LR + 3, 11) = WS.Range("c16").Offset(3, 2).Value
WS1.Cells(LR + 3, 12) = WS.Range("c16").Offset(3, 3).Value
WS1.Cells(LR + 3, 13) = WS.Range("c16").Offset(3, 4).Value
WS1.Cells(LR + 3, 14) = WS.Range("c16").Offset(3, 5).Value
WS1.Cells(LR + 3, 15) = WS.Range("c16").Offset(3, 6).Value
End If
If WS.Cells(20, 3).Value <> "" Then
WS1.Cells(LR + 4, 2) = WS.Range("d4").Value
WS1.Cells(LR + 4, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 4, 3) = WS.Range("f2").Value
WS1.Cells(LR + 4, 4) = WS.Range("f6").Value
WS1.Cells(LR + 4, 5) = WS.Range("d8")
WS1.Cells(LR + 4, 6) = WS.Range("h8")
WS1.Cells(LR + 4, 7) = WS.Range("d10")
WS1.Cells(LR + 4, 8) = WS.Range("d12")
WS1.Cells(LR + 4, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 4, 9) = WS.Range("c16").Offset(4, 0).Value
WS1.Cells(LR + 4, 10) = WS.Range("c16").Offset(4, 1).Value
WS1.Cells(LR + 4, 11) = WS.Range("c16").Offset(4, 2).Value
WS1.Cells(LR + 4, 12) = WS.Range("c16").Offset(4, 3).Value
WS1.Cells(LR + 4, 13) = WS.Range("c16").Offset(4, 4).Value
WS1.Cells(LR + 4, 14) = WS.Range("c16").Offset(4, 5).Value
WS1.Cells(LR + 4, 15) = WS.Range("c16").Offset(4, 6).Value
End If
If WS.Cells(21, 3).Value <> "" Then
WS1.Cells(LR + 5, 2) = WS.Range("d4").Value
WS1.Cells(LR + 5, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 5, 3) = WS.Range("f2").Value
WS1.Cells(LR + 5, 4) = WS.Range("f6").Value
WS1.Cells(LR + 5, 5) = WS.Range("d8")
WS1.Cells(LR + 5, 6) = WS.Range("h8")
WS1.Cells(LR + 5, 7) = WS.Range("d10")
WS1.Cells(LR + 5, 8) = WS.Range("d12")
WS1.Cells(LR + 5, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 5, 9) = WS.Range("c16").Offset(5, 0).Value
WS1.Cells(LR + 5, 10) = WS.Range("c16").Offset(5, 1).Value
WS1.Cells(LR + 5, 11) = WS.Range("c16").Offset(5, 2).Value
WS1.Cells(LR + 5, 12) = WS.Range("c16").Offset(5, 3).Value
WS1.Cells(LR + 5, 13) = WS.Range("c16").Offset(5, 4).Value
WS1.Cells(LR + 5, 14) = WS.Range("c16").Offset(5, 5).Value
WS1.Cells(LR + 5, 15) = WS.Range("c16").Offset(5, 6).Value
End If
If WS.Cells(22, 3).Value <> "" Then
WS1.Cells(LR + 6, 2) = WS.Range("d4").Value
WS1.Cells(LR + 6, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 6, 3) = WS.Range("f2").Value
WS1.Cells(LR + 6, 4) = WS.Range("f6").Value
WS1.Cells(LR + 6, 5) = WS.Range("d8")
WS1.Cells(LR + 6, 6) = WS.Range("h8")
WS1.Cells(LR + 6, 7) = WS.Range("d10")
WS1.Cells(LR + 6, 8) = WS.Range("d12")
WS1.Cells(LR + 6, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 6, 9) = WS.Range("c16").Offset(6, 0).Value
WS1.Cells(LR + 6, 10) = WS.Range("c16").Offset(6, 1).Value
WS1.Cells(LR + 6, 11) = WS.Range("c16").Offset(6, 2).Value
WS1.Cells(LR + 6, 12) = WS.Range("c16").Offset(6, 3).Value
WS1.Cells(LR + 6, 13) = WS.Range("c16").Offset(6, 4).Value
WS1.Cells(LR + 6, 14) = WS.Range("c16").Offset(6, 5).Value
WS1.Cells(LR + 6, 15) = WS.Range("c16").Offset(6, 6).Value
End If
If WS.Cells(23, 3).Value <> "" Then
WS1.Cells(LR + 7, 2) = WS.Range("d4").Value
WS1.Cells(LR + 7, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 7, 3) = WS.Range("f2").Value
WS1.Cells(LR + 7, 4) = WS.Range("f6").Value
WS1.Cells(LR + 7, 5) = WS.Range("d8")
WS1.Cells(LR + 7, 6) = WS.Range("h8")
WS1.Cells(LR + 7, 7) = WS.Range("d10")
WS1.Cells(LR + 7, 8) = WS.Range("d12")
WS1.Cells(LR + 7, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 7, 9) = WS.Range("c16").Offset(7, 0).Value
WS1.Cells(LR + 7, 10) = WS.Range("c16").Offset(7, 1).Value
WS1.Cells(LR + 7, 11) = WS.Range("c16").Offset(7, 2).Value
WS1.Cells(LR + 7, 12) = WS.Range("c16").Offset(7, 3).Value
WS1.Cells(LR + 7, 13) = WS.Range("c16").Offset(7, 4).Value
WS1.Cells(LR + 7, 14) = WS.Range("c16").Offset(7, 5).Value
WS1.Cells(LR + 7, 15) = WS.Range("c16").Offset(7, 6).Value
End If
If WS.Cells(24, 3).Value <> "" Then
WS1.Cells(LR + 8, 2) = WS.Range("d4").Value
WS1.Cells(LR + 8, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 8, 3) = WS.Range("f2").Value
WS1.Cells(LR + 8, 4) = WS.Range("f6").Value
WS1.Cells(LR + 8, 5) = WS.Range("d8")
WS1.Cells(LR + 8, 6) = WS.Range("h8")
WS1.Cells(LR + 8, 7) = WS.Range("d10")
WS1.Cells(LR + 8, 8) = WS.Range("d12")
WS1.Cells(LR + 8, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 8, 9) = WS.Range("c16").Offset(8, 0).Value
WS1.Cells(LR + 8, 10) = WS.Range("c16").Offset(8, 1).Value
WS1.Cells(LR + 8, 11) = WS.Range("c16").Offset(8, 2).Value
WS1.Cells(LR + 8, 12) = WS.Range("c16").Offset(8, 3).Value
WS1.Cells(LR + 8, 13) = WS.Range("c16").Offset(8, 4).Value
WS1.Cells(LR + 8, 14) = WS.Range("c16").Offset(8, 5).Value
WS1.Cells(LR + 8, 15) = WS.Range("c16").Offset(8, 6).Value
End If
If WS.Cells(25, 3).Value <> "" Then
WS1.Cells(LR + 9, 2) = WS.Range("d4").Value
WS1.Cells(LR + 9, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 9, 3) = WS.Range("f2").Value
WS1.Cells(LR + 9, 4) = WS.Range("f6").Value
WS1.Cells(LR + 9, 5) = WS.Range("d8")
WS1.Cells(LR + 9, 6) = WS.Range("h8")
WS1.Cells(LR + 9, 7) = WS.Range("d10")
WS1.Cells(LR + 9, 8) = WS.Range("d12")
WS1.Cells(LR + 9, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 9, 9) = WS.Range("c16").Offset(9, 0).Value
WS1.Cells(LR + 9, 10) = WS.Range("c16").Offset(9, 1).Value
WS1.Cells(LR + 9, 11) = WS.Range("c16").Offset(9, 2).Value
WS1.Cells(LR + 9, 12) = WS.Range("c16").Offset(9, 3).Value
WS1.Cells(LR + 9, 13) = WS.Range("c16").Offset(9, 4).Value
WS1.Cells(LR + 9, 14) = WS.Range("c16").Offset(9, 5).Value
WS1.Cells(LR + 9, 15) = WS.Range("c16").Offset(9, 6).Value
End If
If WS.Cells(26, 3).Value <> "" Then
WS1.Cells(LR + 10, 2) = WS.Range("d4").Value
WS1.Cells(LR + 10, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 10, 3) = WS.Range("f2").Value
WS1.Cells(LR + 10, 4) = WS.Range("f6").Value
WS1.Cells(LR + 10, 5) = WS.Range("d8")
WS1.Cells(LR + 10, 6) = WS.Range("h8")
WS1.Cells(LR + 10, 7) = WS.Range("d10")
WS1.Cells(LR + 10, 8) = WS.Range("d12")
WS1.Cells(LR + 10, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 10, 9) = WS.Range("c16").Offset(10, 0).Value
WS1.Cells(LR + 10, 10) = WS.Range("c16").Offset(10, 1).Value
WS1.Cells(LR + 10, 11) = WS.Range("c16").Offset(10, 2).Value
WS1.Cells(LR + 10, 12) = WS.Range("c16").Offset(10, 3).Value
WS1.Cells(LR + 10, 13) = WS.Range("c16").Offset(10, 4).Value
WS1.Cells(LR + 10, 14) = WS.Range("c16").Offset(10, 5).Value
WS1.Cells(LR + 10, 15) = WS.Range("c16").Offset(10, 6).Value
End If
If WS.Cells(27, 3).Value <> "" Then
WS1.Cells(LR + 11, 2) = WS.Range("d4").Value
WS1.Cells(LR + 11, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 11, 3) = WS.Range("f2").Value
WS1.Cells(LR + 11, 4) = WS.Range("f6").Value
WS1.Cells(LR + 11, 5) = WS.Range("d8")
WS1.Cells(LR + 11, 6) = WS.Range("h8")
WS1.Cells(LR + 11, 7) = WS.Range("d10")
WS1.Cells(LR + 11, 8) = WS.Range("d12")
WS1.Cells(LR + 11, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 11, 9) = WS.Range("c16").Offset(11, 0).Value
WS1.Cells(LR + 11, 10) = WS.Range("c16").Offset(11, 1).Value
WS1.Cells(LR + 11, 11) = WS.Range("c16").Offset(11, 2).Value
WS1.Cells(LR + 11, 12) = WS.Range("c16").Offset(11, 3).Value
WS1.Cells(LR + 11, 13) = WS.Range("c16").Offset(11, 4).Value
WS1.Cells(LR + 11, 14) = WS.Range("c16").Offset(11, 5).Value
WS1.Cells(LR + 11, 15) = WS.Range("c16").Offset(11, 6).Value
End If
If WS.Cells(28, 3).Value <> "" Then
WS1.Cells(LR + 12, 2) = WS.Range("d4").Value
WS1.Cells(LR + 12, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 12, 3) = WS.Range("f2").Value
WS1.Cells(LR + 12, 4) = WS.Range("f6").Value
WS1.Cells(LR + 12, 5) = WS.Range("d8")
WS1.Cells(LR + 12, 6) = WS.Range("h8")
WS1.Cells(LR + 12, 7) = WS.Range("d10")
WS1.Cells(LR + 12, 8) = WS.Range("d12")
WS1.Cells(LR + 12, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 12, 9) = WS.Range("c16").Offset(12, 0).Value
WS1.Cells(LR + 12, 10) = WS.Range("c16").Offset(12, 1).Value
WS1.Cells(LR + 12, 11) = WS.Range("c16").Offset(12, 2).Value
WS1.Cells(LR + 12, 12) = WS.Range("c16").Offset(12, 3).Value
WS1.Cells(LR + 12, 13) = WS.Range("c16").Offset(12, 4).Value
WS1.Cells(LR + 12, 14) = WS.Range("c16").Offset(12, 5).Value
WS1.Cells(LR + 12, 15) = WS.Range("c16").Offset(12, 6).Value
End If
If WS.Cells(29, 3).Value <> "" Then
WS1.Cells(LR + 13, 2) = WS.Range("d4").Value
WS1.Cells(LR + 13, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 13, 3) = WS.Range("f2").Value
WS1.Cells(LR + 13, 4) = WS.Range("f6").Value
WS1.Cells(LR + 13, 5) = WS.Range("d8")
WS1.Cells(LR + 13, 6) = WS.Range("h8")
WS1.Cells(LR + 13, 7) = WS.Range("d10")
WS1.Cells(LR + 13, 8) = WS.Range("d12")
WS1.Cells(LR + 13, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 13, 9) = WS.Range("c16").Offset(13, 0).Value
WS1.Cells(LR + 13, 10) = WS.Range("c16").Offset(13, 1).Value
WS1.Cells(LR + 13, 11) = WS.Range("c16").Offset(13, 2).Value
WS1.Cells(LR + 13, 12) = WS.Range("c16").Offset(13, 3).Value
WS1.Cells(LR + 13, 13) = WS.Range("c16").Offset(13, 4).Value
WS1.Cells(LR + 13, 14) = WS.Range("c16").Offset(13, 5).Value
WS1.Cells(LR + 13, 15) = WS.Range("c16").Offset(13, 6).Value
End If
If WS.Cells(30, 3).Value <> "" Then
WS1.Cells(LR + 14, 2) = WS.Range("d4").Value
WS1.Cells(LR + 14, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 14, 3) = WS.Range("f2").Value
WS1.Cells(LR + 14, 4) = WS.Range("f6").Value
WS1.Cells(LR + 14, 5) = WS.Range("d8")
WS1.Cells(LR + 14, 6) = WS.Range("h8")
WS1.Cells(LR + 14, 7) = WS.Range("d10")
WS1.Cells(LR + 14, 8) = WS.Range("d12")
WS1.Cells(LR + 14, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 14, 9) = WS.Range("c16").Offset(14, 0).Value
WS1.Cells(LR + 14, 10) = WS.Range("c16").Offset(14, 1).Value
WS1.Cells(LR + 14, 11) = WS.Range("c16").Offset(14, 2).Value
WS1.Cells(LR + 14, 12) = WS.Range("c16").Offset(14, 3).Value
WS1.Cells(LR + 14, 13) = WS.Range("c16").Offset(14, 4).Value
WS1.Cells(LR + 14, 14) = WS.Range("c16").Offset(14, 5).Value
WS1.Cells(LR + 14, 15) = WS.Range("c16").Offset(14, 6).Value
End If
If WS.Cells(31, 3).Value <> "" Then
WS1.Cells(LR + 15, 2) = WS.Range("d4").Value
WS1.Cells(LR + 15, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 15, 3) = WS.Range("f2").Value
WS1.Cells(LR + 15, 4) = WS.Range("f6").Value
WS1.Cells(LR + 15, 5) = WS.Range("d8")
WS1.Cells(LR + 15, 6) = WS.Range("h8")
WS1.Cells(LR + 15, 7) = WS.Range("d10")
WS1.Cells(LR + 15, 8) = WS.Range("d12")
WS1.Cells(LR + 15, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 15, 9) = WS.Range("c16").Offset(15, 0).Value
WS1.Cells(LR + 15, 10) = WS.Range("c16").Offset(15, 1).Value
WS1.Cells(LR + 15, 11) = WS.Range("c16").Offset(15, 2).Value
WS1.Cells(LR + 15, 12) = WS.Range("c16").Offset(15, 3).Value
WS1.Cells(LR + 15, 13) = WS.Range("c16").Offset(15, 4).Value
WS1.Cells(LR + 15, 14) = WS.Range("c16").Offset(15, 5).Value
WS1.Cells(LR + 15, 15) = WS.Range("c16").Offset(15, 6).Value
End If
If WS.Cells(32, 3).Value <> "" Then
WS1.Cells(LR + 16, 2) = WS.Range("d4").Value
WS1.Cells(LR + 16, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 16, 3) = WS.Range("f2").Value
WS1.Cells(LR + 16, 4) = WS.Range("f6").Value
WS1.Cells(LR + 16, 5) = WS.Range("d8")
WS1.Cells(LR + 16, 6) = WS.Range("h8")
WS1.Cells(LR + 16, 7) = WS.Range("d10")
WS1.Cells(LR + 16, 8) = WS.Range("d12")
WS1.Cells(LR + 16, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 16, 9) = WS.Range("c16").Offset(16, 0).Value
WS1.Cells(LR + 16, 10) = WS.Range("c16").Offset(16, 1).Value
WS1.Cells(LR + 16, 11) = WS.Range("c16").Offset(16, 2).Value
WS1.Cells(LR + 16, 12) = WS.Range("c16").Offset(16, 3).Value
WS1.Cells(LR + 16, 13) = WS.Range("c16").Offset(16, 4).Value
WS1.Cells(LR + 16, 14) = WS.Range("c16").Offset(16, 5).Value
WS1.Cells(LR + 16, 15) = WS.Range("c16").Offset(16, 6).Value
End If
If WS.Cells(33, 3).Value <> "" Then
WS1.Cells(LR + 17, 2) = WS.Range("d4").Value
WS1.Cells(LR + 17, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 17, 3) = WS.Range("f2").Value
WS1.Cells(LR + 17, 4) = WS.Range("f6").Value
WS1.Cells(LR + 17, 5) = WS.Range("d8")
WS1.Cells(LR + 17, 6) = WS.Range("h8")
WS1.Cells(LR + 17, 7) = WS.Range("d10")
WS1.Cells(LR + 17, 8) = WS.Range("d12")
WS1.Cells(LR + 17, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 17, 9) = WS.Range("c16").Offset(17, 0).Value
WS1.Cells(LR + 17, 10) = WS.Range("c16").Offset(17, 1).Value
WS1.Cells(LR + 17, 11) = WS.Range("c16").Offset(17, 2).Value
WS1.Cells(LR + 17, 12) = WS.Range("c16").Offset(17, 3).Value
WS1.Cells(LR + 17, 13) = WS.Range("c16").Offset(17, 4).Value
WS1.Cells(LR + 17, 14) = WS.Range("c16").Offset(17, 5).Value
WS1.Cells(LR + 17, 15) = WS.Range("c16").Offset(17, 6).Value
End If
If WS.Cells(34, 3).Value <> "" Then
WS1.Cells(LR + 18, 2) = WS.Range("d4").Value
WS1.Cells(LR + 18, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 18, 3) = WS.Range("f2").Value
WS1.Cells(LR + 18, 4) = WS.Range("f6").Value
WS1.Cells(LR + 18, 5) = WS.Range("d8")
WS1.Cells(LR + 18, 6) = WS.Range("h8")
WS1.Cells(LR + 18, 7) = WS.Range("d10")
WS1.Cells(LR + 18, 8) = WS.Range("d12")
WS1.Cells(LR + 18, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 18, 9) = WS.Range("c16").Offset(18, 0).Value
WS1.Cells(LR + 18, 10) = WS.Range("c16").Offset(18, 1).Value
WS1.Cells(LR + 18, 11) = WS.Range("c16").Offset(18, 2).Value
WS1.Cells(LR + 18, 12) = WS.Range("c16").Offset(18, 3).Value
WS1.Cells(LR + 18, 13) = WS.Range("c16").Offset(18, 4).Value
WS1.Cells(LR + 18, 14) = WS.Range("c16").Offset(18, 5).Value
WS1.Cells(LR + 18, 15) = WS.Range("c16").Offset(18, 6).Value
End If
If WS.Cells(35, 3).Value <> "" Then
WS1.Cells(LR + 19, 2) = WS.Range("d4").Value
WS1.Cells(LR + 19, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 19, 3) = WS.Range("f2").Value
WS1.Cells(LR + 19, 4) = WS.Range("f6").Value
WS1.Cells(LR + 19, 5) = WS.Range("d8")
WS1.Cells(LR + 19, 6) = WS.Range("h8")
WS1.Cells(LR + 19, 7) = WS.Range("d10")
WS1.Cells(LR + 19, 8) = WS.Range("d12")
WS1.Cells(LR + 19, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 19, 9) = WS.Range("c16").Offset(19, 0).Value
WS1.Cells(LR + 19, 10) = WS.Range("c16").Offset(19, 1).Value
WS1.Cells(LR + 19, 11) = WS.Range("c16").Offset(19, 2).Value
WS1.Cells(LR + 19, 12) = WS.Range("c16").Offset(19, 3).Value
WS1.Cells(LR + 19, 13) = WS.Range("c16").Offset(19, 4).Value
WS1.Cells(LR + 19, 14) = WS.Range("c16").Offset(19, 5).Value
WS1.Cells(LR + 19, 15) = WS.Range("c16").Offset(19, 6).Value
End If
If WS.Cells(36, 3).Value <> "" Then
WS1.Cells(LR + 20, 2) = WS.Range("d4").Value
WS1.Cells(LR + 20, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 20, 3) = WS.Range("f2").Value
WS1.Cells(LR + 20, 4) = WS.Range("f6").Value
WS1.Cells(LR + 20, 5) = WS.Range("d8")
WS1.Cells(LR + 20, 6) = WS.Range("h8")
WS1.Cells(LR + 20, 7) = WS.Range("d10")
WS1.Cells(LR + 20, 8) = WS.Range("d12")
WS1.Cells(LR + 20, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 20, 9) = WS.Range("c16").Offset(20, 0).Value
WS1.Cells(LR + 20, 10) = WS.Range("c16").Offset(20, 1).Value
WS1.Cells(LR + 20, 11) = WS.Range("c16").Offset(20, 2).Value
WS1.Cells(LR + 20, 12) = WS.Range("c16").Offset(20, 3).Value
WS1.Cells(LR + 20, 13) = WS.Range("c16").Offset(20, 4).Value
WS1.Cells(LR + 20, 14) = WS.Range("c16").Offset(20, 5).Value
WS1.Cells(LR + 20, 15) = WS.Range("c16").Offset(20, 6).Value
End If
If WS.Cells(37, 3).Value <> "" Then
WS1.Cells(LR + 21, 2) = WS.Range("d4").Value
WS1.Cells(LR + 21, 2).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 21, 3) = WS.Range("f2").Value
WS1.Cells(LR + 21, 4) = WS.Range("f6").Value
WS1.Cells(LR + 21, 5) = WS.Range("d8")
WS1.Cells(LR + 21, 6) = WS.Range("h8")
WS1.Cells(LR + 21, 7) = WS.Range("d10")
WS1.Cells(LR + 21, 8) = WS.Range("d12")
WS1.Cells(LR + 21, 8).NumberFormat = "dd-mm-yyyy"
WS1.Cells(LR + 21, 9) = WS.Range("c16").Offset(21, 0).Value
WS1.Cells(LR + 21, 10) = WS.Range("c16").Offset(21, 1).Value
WS1.Cells(LR + 21, 11) = WS.Range("c16").Offset(21, 2).Value
WS1.Cells(LR + 21, 12) = WS.Range("c16").Offset(21, 3).Value
WS1.Cells(LR + 21, 13) = WS.Range("c16").Offset(21, 4).Value
WS1.Cells(LR + 21, 14) = WS.Range("c16").Offset(21, 5).Value
WS1.Cells(LR + 21, 15) = WS.Range("c16").Offset(21, 6).Value
End If

Application.ScreenUpdating = True
End Sub

دعونا نتطرق الى شرح الكود

Application.ScreenUpdating = False

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

Dim LR As Long

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

Dim WS As Worksheet
Dim WS1 As Worksheet

تعريف كلا من المتغير ws والمتغير ws1 على انهما شيت اكسيل

Set WS = Worksheets("INVOICE")

تحديد المتغير ws وتعريفه على انه عباره عن الشيت المسمى ب invoice

Set WS1 = Worksheets("INVOICE DATA")

تحديد المتغير ws1 وتعريفه على انه عباره عن الشيت المسمى ب INVOICE DATA

LR = WS1.Range("e10000").End(xlUp).Row + 1

هنا يتم تحديد المتغير LR وتعريفه على انه عباره عن اخر خليه بها بيانات فى العمود E (اسم العميل)مضافا اليها خليه واحده (اى اول خليه فارغه فى العمود E) وذلك حتى الخليه E10000 وذلك فى الشيت المعرف ب WS1 اى فى شيت INVOICE DATA

LR1 = WS1.Range("c10000").End(xlUp).Row + 1

هنا يتم تحديد المتغير LR1 وتعريفه على انه عباره عن اخر خليه بها بيانات فى العمود C (رقم الفاتوره)مضافا اليها خليه واحده (اى اول خليه فارغه فى العمود C) وذلك حتى الخليه C10000 وذلك فى الشيت المعرف ب WS1 اى فى شيت INVOICE DATA

    For r = 3 To LR1

هنا يتم استخدام الخلقه التكراريه بدايه من السطر الثالث وحتى اخر سطر به بيانات فى شيت INVOICE DATA

If WS1.Cells(r, 3) = WS.Range("f2") Then MsgBox "This invoice already exist, No shift will done": Exit Sub

هنا نقول انه اذا كان المتغير R اى بداية من السطر3 وحتى اخر سطر به بيانات فى شيت INVOICE DATA فى العمود الثالث يساوى الخليه F2 فى شيت INVOICE يتم اظهار الرساله التى تفيد بأن الرقم المدخل موجود من قبل

بمعنى انه فى حالة كتابة الرقم 5 مثلا فى الخليه F2 وهذا الرقم موجود فى احدى الخلايا بداية من السطر الثالث وحتى اخر سطر به بيانات فى العمود 3 يتم ظهور الرساله التى تفيد بان الرقم موجود من قبل

Exit Sub

الخروج من الحلقه التكراريه وعدم تنفيذ شئ بعد ذلك

NEXT

طالما بدأنا ب FOR اذا لابد من اقفال الكود ب NEXT

وبذلك نكون قد انتهينا من وضع الكود الخاص بعدم السماح بتكرار رقم القاتوره

الان نبدأ بوضع شروط الترحيل

If WS.Range("d4").Value = "" Then MsgBox "enter invoice date": Exit Sub

فى حالة فراغ الخليه d4 فى شيت invoice تظهر رساله تفيد بانه يجب كتابة التاريخ ثم نستخدم Exit Sub للخروخ من الكود وعدم تنفيذ شئ فى حالة الفراغ

If WS.Cells(16, 3).Value = "" Then MsgBox "حد ادنى صف واحد لكى يسمح للفاتورة بالترحيل ": Exit Sub

هنا بنقول انه فى حالة ان الخليه الواقعه فى السطر 16 وفى العمود 3 فى شيت invoice اى الخليه c16 فارغه يتم ظهور رساله تفيد بانه لايمكن الترحيل

الا بكتابة سطر على الاقل من الفاتوره ثم نستخدم Exit Sub للخروج من الكود وعدم تنفيذ شئ فى حالة الفراغ

ثم بعد تحقق الشرطين السابقين يبدأ الترحيل

فاذا نظرنا الى الفاتوره سنجد انها مكونه من جزئين

الجزء الاول وهو الجزء العلوى الذى يحتوى على --رقم الفاتوره-تاريخ الفاتوره-كود العميل-اسم العميل-عنوان العميل-ت الاستحقاق

الجزء الثانى وهو الجزء السفلى من الفاتوره المكون من صفوف الفاتوره والتى عددها 22 صف

وحيث اننا نريد ترحيل بيانات الفاتوره العلويه مع كل سطر من سطور الفاتوره التى فى الجزء السفلى فسوف يتم وضع شروط لترحيل كل سطر

وبذلك سيكون لدينا 22 شرط كل شرط مرتبط بسطر معين

وطبعا لعدم الاطاله فى الشرح فسيتم تناول شرح كيفية ترحيل السطر الاول فقط ثم يمكنكم تطبيق الشرح على باقى السطور

If WS.Cells(16, 3).Value <> "" Then

هذا هو الشرط الاول

بنقول فيه انه فى حالة ان الخليه الواقعه فى السطر 16 وفى العمود 3 فى شيت invoice اى الخليه c16 غير فارغه يتم الاتى

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

لذلك ستم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها تاريخ الفاتوره فى شيت INVOICE الى العمود الخاص بالتاريخ فى شيت INVOICE DATA

WS1.Cells(LR, 2) = WS.Range("d4").Value

طبعا هنا بنذكر ان المتغير LR تم تعريفه على انه الوصول الى اخر خليه بها بيانات اى اول خليه فارغه فى العمود e عمود اسم العميل

وبالنظر الى شيت INVOICE DATA سنجد ان اول خليه فارغه هى B3 اى ان الترحيل سيكون بداية من السطر 3

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 2 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D4 فى شيت WS اى فى شيت INVOICE

ثم نقوم بوضع كود اخر لاظهار القيم المرحله الى عمود التاريخ على انها تاريخ كما فى الكود الاتى

WS1.Cells(LR, 2).NumberFormat = "dd-mm-yyyy"

كما هو موضح من شكل الكود انه يتم عمل تنسيق للعمود2 فى شيت INVOICE DATA على انها تاريخ يظهر بالشكل الاتى    سنه-شهر-يوم

 

بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان ثانى عمود سيتم الترحيل اليه هو عمود رقم الفاتوره

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها رقم الفاتوره فى شيت INVOICE الى العمود الخاص برقم الفاتوره فى شيت INVOICE DATA

WS1.Cells(LR, 3) = WS.Range("f2").Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 3 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمةالخليه F2 فى شيت WS اى فى شيت INVOICE

 

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

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها كود العميل فى شيت INVOICE الى العمود الخاص بكود العميل فى شيت INVOICE DATA

WS1.Cells(LR, 4) = WS.Range("f6").Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 4 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمةالخليه F6 فى شيت WS اى فى شيت INVOICE

 

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

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها اسم العميل فى شيت INVOICE الى العمود الخاص اسم العميل فى شيت INVOICE DATA

WS1.Cells(LR, 5) = WS.Range("d8")

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 5 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D8 فى شيت WS اى فى شيت INVOICE

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

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها تليفون العميل فى شيت INVOICE الى العمود الخاص تليفون

العميل فى شيت INVOICE DATA

WS1.Cells(LR, 6) = WS.Range("h8")

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 6 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه H8 فى شيت WS اى فى شيت INVOICE

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

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها عنوان العميل فى شيت INVOICE الى العمود الخاص بعنوان

العميل فى شيت INVOICE DATA

WS1.Cells(LR, 7) = WS.Range("d10")

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 7 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D10 فى شيت WS اى فى شيت INVOICE

بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان سابع عمود سيتم الترحيل اليه هو عمود ت الاستحقاق

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها ت الاستحقاق فى شيت INVOICE الى العمود الخاص بتاريخ

الاستحقاق فى شيت INVOICE DATA

WS1.Cells(LR, 8) = WS.Range("d12")

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 8 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D12 فى شيت WS اى فى شيت INVOICE

هنا نكون انتهينا من ترحيل الصفوف العلويه

 

الان نبدأ بترحيل الجزء الثانى من الفاتوره وهو ترحيل سطورها

 

السطر الاول

بالنظر الى الفاتوره نجد ان اول سطر فى الفاتوره  يبدأ من السطر 16 فى شيت invoice

بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان ثامن عمود سيتم الترحيل اليه هو عمود كود الصنف

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الثانى عمود( كود الصنف )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود كود الصنف

WS1.Cells(LR, 9) = WS.Range("c16").Offset(0, 0).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 9 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS اى فى شيت INVOICE

بالنظر الى الفاتوره نجد ان اول سطر يبدأ من السطر 16 فى شيت invoice

بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان تاسع عمود سيتم الترحيل اليه هو عمود اسم الصنف

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الثالث عمود( اسم الصنف )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود اسم الصنف

WS1.Cells(LR, 10) = WS.Range("c16").Offset(0, 1).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 10 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمةالخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وعمود اضافى  (اى فى شيت INVOICE )

بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA  فى العمود 10 هى j3  اذا قيمة  J3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه عمود واحد اذا اصبحنا فى d16 لتصبح قيمة الخليه j3 تساوى قيمة الخليه d16

 

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

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الرابع (الوحده )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود الوحده

WS1.Cells(LR, 11) = WS.Range("c16").Offset(0, 2).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 11 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة عمودين اضافين  (اى فى شيت INVOICE )

بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA  فى العمود 11 هى k3  اذا قيمة  k3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه عمودين  اذا اصبحنا فى e16 لتصبح قيمة الخليه k3 تساوى قيمة الخليه e16

 

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

لذلك سبتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الخامس ( الكميه )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود الكميه

WS1.Cells(LR, 12) = WS.Range("c16").Offset(0, 3).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 12 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة ثلاثه اعمده اضافيه (اى فى شيت INVOICE )

بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA  فى العمود 12 هى L3  اذا قيمة  L3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه ثلاثه اعمده  اذا اصبحنا فى F16 لتصبح قيمة الخليه L3 تساوى قيمة الخليه F16

 

بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود الثانى العاشر الذى سيتم الترحيل اليه هو عمود السعر

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود السادس ( السعر )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود السعر

WS1.Cells(LR, 13) = WS.Range("c16").Offset(0, 4).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 13 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة اربعة اعمده اضافيه (اى فى شيت INVOICE )

بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA  فى العمود 13 هى M3  اذا قيمة  M3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه اربعة اعمده  اذا اصبحنا فى G16 لتصبح قيمة الخليه M3 تساوى قيمة الخليه G16

 

بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود الثالث عشر الذى سيتم الترحيل اليه هو عمود القيمه

لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود السابع ( القيمه )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود القيمه

WS1.Cells(LR, 14) = WS.Range("c16").Offset(0, 5).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 14 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة خمسة اعمده اضافيه (اى فى شيت INVOICE )

بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA  فى العمود 14 هى N3  اذا قيمة  N3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه خمسة اعمده  اذا اصبحنا فى H16 لتصبح قيمة الخليه N3 تساوى قيمة الخليه H16

 

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

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

  السابع ( الملاحظات )من اعمده الفاتوره التى بها بيانات وذلك فى  شيت INVOICE  الى  شيت INVOICE DATA فى عمود الملاحظات

WS1.Cells(LR, 15) = WS.Range("c16").Offset(0, 6).Value

وبالتالى فهنا نقول ان اول خليه فارغه  فى العمود 15 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة ستة اعمده اضافيه (اى فى شيت INVOICE )

بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA  فى العمود 15 هى O3  اذا قيمة O3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه ستة اعمده  اذا اصبحنا فى i16 لتصبح قيمة الخليه O3 تساوى قيمة الخليه i16

 

الكلام ده ينطبق على باقى الكود

 

اود ان انبه على شئ من اجل التسهيل فى فهم باقى الكود

 

مثلا لو افترضنا ان اول خليه فارغه فى شيت invoice data فى العمود c هى c3

فمن اجل ادخال البيانات فى هذه الخليه نستخدم الكود

WS1.Cells(LR

وطبعا احنا معرفين LR فى الكود على انه الوصول الى اخر خليه بها بيانات مضافا اليها خليه واحده اى الوصول الى اول خليه فارغه اى C3

فلما نقول ان    WS1.Cells(LR, 3) = WS.Range("f2").Value

وبما ان C2هى اخر خليه بها بيانات فلما نضيف عليها خليه تصبح C3  اول خليه فارغه تساوى قيمة الخليه F2 ولو ان

قيمة F2 تساوى 10 اى ان C3 اصبح بها الرقم 10 ايضا فلو كتبنا السطر التالى

WS1.Cells(LR+1

فهذا يعنى الوصول الى اخر بخليه بها بيانات مضافا اليها خليه اخرى وبما ان  C3 ُاصبح بها الرقم 10 اذا  سنضيف خليه اخرى على الخليه c3 وذلك باضافة الرقم 1 لتصبح C4

او بمعنى اخر الوصول الى ثانى خليه فارغه بعد اخر خليه بها بيانات وحيث ان اخر خليه كان بها بيانات هى C2 فان ثانى خليه بعدها هى C4

وهكذا

............................................................................................................................................................................................................................

الان نقوم بتجربه الملف المرفق لرؤيه عمل الكود على حده

 

شاهد  المرفق    5-EXCEL

-----------------------------------------------------------------------------------

الان قد انتهينا من شرح

الدرس الثانى ( خ )  الكود الخامس---كود يقوم بترحيل بيانات الفاتوره الى شيت invoice date

اتمنى ان اكون قد وفقت فى الشرح

 

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

5-EXCEL.rar

KHMB

KHMB

قام بنشر
قام بنشر

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

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

الله يعينك ويصبرك ويوفقك

إبراهيم ابوليله

إبراهيم ابوليله

قام بنشر
  • الكاتب
قام بنشر

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

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

الله يعينك ويصبرك ويوفقك

اخى

اشكرك على المتابعه المستمره للموضوع

واتمنى ان اكون قد وفقت فى شرح الدرس السابق

تقبل تحياتى

  • 4 weeks later...
تامر الشوربجي

تامر الشوربجي

قام بنشر
قام بنشر

اخي الفاضل ابراهيم احييك علي مجهودك الرائع وشرحك الوافي المتميز

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

 

ولك خالص التقدير

إبراهيم ابوليله

إبراهيم ابوليله

قام بنشر
  • الكاتب
قام بنشر

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

استاذى الحبيب ابراهيم

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

اني اوريد اويدالمتابعةعلى صورهلاتعمل

اخى ابا اسماعيل

ممكن التوضيح اكثر

تقبل تحياتى

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع


×
×
  • اضف...

Important Information

  I accept