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

[ABURYAN3]

صممت على إكسيل فاتورة مبيعات واستخدم هذه الفاتورة بإستمرار وكلما اريد عمل فاتورة جديدة يتم إلغاء بيانات الفاتورة السابقة لتكتب مكانها بيانات الفاتورة الجديدة ولم أحتفظ بجميع بيانات الفاتورة السابقة فاريد أن أعمل خلاصة لهذه الفواتير في ورقة اكسل واحدة من ضمن الملف ولتكن هي ورقة 2 أو 3 بحيث أضغط على زر في الفاتورة فتنتقل البيانات من الفاتورة الأساسية إلى ورقة الخلاصة وتأخذ كل فاتورة سطر فقط في صفحة الخلاصة وهذا السطر يشتمل على :

( مسلسل ـ رقم الفاتورة ـ تاريخها ـ اسم العميل ـ مجموع الفاتورة )

ومن الأفضل يكون المسلسل AUTO

لتكون صفحة الخلاصة مرجع لي لما تم عمله من فواتير 0

[محمد حجازي]

السلام عليكم ...

طبق يا أخي الطريقة التالية :

قم أولاً برسم الفاتورة وجدول الخلاصة وضع كل واحد منهم في ورقة منفصلة :

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

(راجع المثال المبسط الموجود في المرفق)

الكود هو التالي :

Sub MoveData()
  Dim EndRow As Long
  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
End Sub

لاحظ يا أخي ما يلي :

EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count

وضعنا في المتغير EndRow رقم آخر سطر مليئ في جدول الخلاصة .

Sheets("List").Cells(EndRow + 1, 1).Value = EndRow

و اللآن سنقوم بإدراج البيانات في أول سطر فارغ موجود في ورقة الخلاصة List (وذلك بالاعتماد على الرقم المخزن داخل المتغير EndRow ).

Sheets("List").Cells(EndRow + 1, 1).Value = EndRow

هنا أدرجنا الترقيم التلقائي .

 Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value

وهنا أدرجنا اسم الزبون . وهكذا للبقية ... لاحظ أخي أننا استخدمنا التعليمة Cells للإشارة إلى الخلايا المختلفة (المدخل الأول هو رقم سطر الخلية ، و المدخل الثاني هو رقم عامود الخلية) ، ولاحظ أنه يجب علينا الإشارة للأوراق المطلوبة عن طريق التعليمة Sheets .

Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents

هنا قمنا بحذف جميع البيانات الموجودة داخل النطاقات B3,D3,A5:D5,D6,B8,D8 .

يمكنك إنشاء برنامج شبيه بهذا إذا اتبعت نفس الخطوات .

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

بالتوفيق

invoice.rar

[ABURYAN3]

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

الأستاذ محمد حجازي حفظه الله ،،،
ماذا يقصد بالأرقام التي في صفحة الكود في نهاية الأسطر التي تبدأ بي sheets مثل :
3.2
3.4
5.1
6.4
8.2
8.4

وإذا بالإمكان ماهو الأمر أو الأرقام المسئولة داخل الكود الذي عملته لي الذي يربط مثل : (اسم العميل) مثلاً في الفاتورة بنفس الحقل الذي أريده أن يظهر فيه في صفحة الخلاصة 0
مع العلم بأنني طبقة الخطوات ونجحت فيها تقريباً 70% ولكن ناقصني ظهور الحقول في صفحة الخلاصة 0

ولكم مني كل احترام وتقدير 0

[محمد حجازي]

ماذا يقصد بالأرقام التي في صفحة الكود في نهاية الأسطر التي تبدأ بي sheets مثل :

3.2

3.4

5.1

6.4

8.2

8.4

الأرقام هذه هي عبارة عن رقم صف وعامود الخلية التي نشير إليها ، فمثلاً نحن في السطر التالي :

Sheets("Invoice").Cells(3, 2).Value

نشير لقيمة الخلية الموجودة في الورقة Invoice و في الصف الثالث و العامود الثاني (أي الخلية B3 "اسم الزبون").

وإذا بالإمكان ماهو الأمر أو الأرقام المسئولة داخل الكود الذي عملته لي الذي يربط مثل : (اسم العميل) مثلاً في الفاتورة بنفس الحقل الذي أريده أن يظهر فيه في صفحة الخلاصة 0

حسناً ، أمعن النظر في السطر التالي وذلك لأننا سنشرحه بعد قليل :

  Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value

السطر السابق يقوم بإعطاء الخلية المتوضعة في الورقة List و في السطر EndRow + 1 و العامود 2 (أي الخلية الموجودة في أول صف فارغ من حقل الزبون) نفس القيمة الموجودة في الخلية المتوضعة في الورقة Invoice و في السطر الثالث و العامود الثاني (الخلية B3 من الورقة Invoice). أي أننا قمنا بنسخ قيمة الخلية الموجودة على يمين المساواة ولصقها في الخلية الموجودة على يسار المساواة. وهكذا نكرر نفس العملية بالنسبة لمحرر الفاتورة و وتاريخ التحرير و .... الخ. وفي النهاية فإننا بحاجة لتفريغ محتويات الفاتورة المرحلة عن طريق السطر التالي :

  Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents

أرجو أن أكون قد وفقت في الشرح

[ABURYAN3]

الأخ محمد حجازي :

وفقك الله ياأستاذي لقد نجحت في برنامجي الخاص بالفواتير 100% وكل هذا بفضل الله ثم بتعاونكم وجهدكم ومتابعتكم والشرح الجيد المفهوم ولكن يوجد مشكله بسيطه لم نتطرق لها في موضوعنا وهي :

عندما أكتب فاتورة ثم يعمل لها ترحيل تمسح الحقول للفاتورة وهذا جيد 0

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

والمطلوب هو ربط الترحيل برقم الفاتورة فإذا كان هناك رقم فاتورة موجود مدخل يدوي فيعمل ترحيل وإذا كان رقم الفاتورة خالي فلا يفتح سطر جديد في الخلاصة (( مع العلم أنني أدخل رقم الفاتورة يدوياً حسب طبيعة عملي ولي auto ))

وآمل أن يضاف الكود الجديد إذا بالإمكان مع الكود السابق الذي عملته سابقاً لأنني لا أعرف تركيب الأوامر مع بعض 100% وأيضا على نفس البرنامج 0

ولكم مني خالص الشكر والتقدير ،،،،

[محمد حجازي]

السلام عليكم ...

الأخ ABURYAN3 ، للتسهيل سأطبق ذلك على "اسم الزبون" و الطريقة نفسها بالنسبة لأي بند من بنود الفاتورة .

فقط طبق الشرط IF كالتالي :

Sub MoveData()
  Dim EndRow As Long
  If Sheets("Invoice").Range("B3").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
  End If
End Sub

ويمكنك إضافة عبارتي OR أو AND للشرط IF (في حال رغبتك بوضع أكثر من شرط) ، وذلك كما يلي (بالنسبة لاسم الزبون ومكان الإقامة) :

Sub MoveData()
  Dim EndRow As Long
  If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").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
  End If
End Sub

Sub MoveData()
  Dim EndRow As Long
  If Sheets("Invoice").Range("B3").Value = "" And Sheets("Invoice").Range("D3").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
  End If
End Sub

وبنفس الطريقة إذا كنت ترغب بإضافة أكثر من شرطين ....

ملاحظة : يمكن اختصار الكود السابق ، ولكن هذا الشكل أسهل للفهم.

تحياتي

[ABURYAN3]

وفقك الله :ـ

ياأخ محمد حجازي 0

لقد أستفدت ونفذت ،

أخوك ABURYAN3