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

**إبراهيم ابوليله** · ديسمبر 23, 2014

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

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

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

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

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

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

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

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

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

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

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

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

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

وهى

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

اى 1*2=2

وهكذا

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

شرح الكود

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

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

عبد المؤمن · ديسمبر 24, 2014

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

**إبراهيم ابوليله** · ديسمبر 25, 2014

اخى عبد المؤمن

اشكرك على المتابعه

وعلى الدعاء الجميل

واتمنى لك الاستفاده

تقبل تحياتى

**KHMB** · ديسمبر 29, 2014

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

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

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

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

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

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

جزاك الله خير

hanymanaa · ديسمبر 30, 2014

في انتظار التكملة

الموضوع اكثر من رائع :wow:

اثابك الله وجعل عملك في ميزان حسناتك :fff:

**إبراهيم ابوليله** · ديسمبر 31, 2014

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

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

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

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

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

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

جزاك الله خير

اخى kmb

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

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

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

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

تقبل تحياتى

**KHMB** · ديسمبر 31, 2014

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

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

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

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

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

جزاك الله خير

**إبراهيم ابوليله** · يناير 1, 2015

في انتظار التكملة

الموضوع اكثر من رائع

اثابك الله وجعل عملك في ميزان حسناتك

اخى

ان شاء الله غدا ييتم

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

تقبل تحياتى

**إبراهيم ابوليله** · يناير 1, 2015

اخى kmb

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

واتمنى ان يكون مستفادا منه

غدا ان شاء الله يتم استكمال الشرح

تقبل تحياتى

**إبراهيم ابوليله** · يناير 8, 2015

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

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

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

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

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

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

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

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

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

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

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

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

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

وهى

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

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

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

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

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

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

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

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

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

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

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

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

الدرس الثانى ( خ ) الكود الخامس---كود يقوم بترحيل بيانات الفاتوره الى شيت 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** · يناير 8, 2015

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

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

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

**إبراهيم ابوليله** · يناير 10, 2015

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

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

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

اخى

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

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

تقبل تحياتى

تامر الشوربجي · فبراير 1, 2015

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

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

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

**إبراهيم ابوليله** · فبراير 1, 2015

اخى تامر

ان شاء الله يتم استكمال الدروس قريبا

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

وكثره المشاغل

تقبل تحياتى

ابا اسماعيل · فبراير 2, 2015

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

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

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

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

**إبراهيم ابوليله** · فبراير 3, 2015

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

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

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

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

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

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

تقبل تحياتى

ابا اسماعيل · فبراير 3, 2015

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

استاذى الحبيب ابراهيم لقد حل المسكيل في flash player

ابا اسماعيل · فبراير 3, 2015

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

**إبراهيم ابوليله** · فبراير 3, 2015

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

هل تقصد بذلك الكود ان يكون الشرح

على العمود الذى يتم عمل التسلسل فيه

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

تقبل تحياتى

ابا اسماعيل · فبراير 3, 2015

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

العمود الذى يتم عمل التسلسل فيه

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

ابا اسماعيل · فبراير 3, 2015

اربد ترقيم تسلسل في العمود d

**إبراهيم ابوليله** · فبراير 3, 2015

اخى

اين الشيت الذى تريد التنفيذ عليه

ابا اسماعيل · فبراير 3, 2015

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

2015.zip

**إبراهيم ابوليله** · فبراير 3, 2015

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

تم عمل الكود

تقبل تحياتى

**إبراهيم ابوليله** · فبراير 3, 2015

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

تم عمل الكود

تقبل تحياتى

2015.rar

تسجيل الدخول

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

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

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

شارك

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

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

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

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

Posted Images

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

Join the conversation

محتوي مشابه

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

Important Information