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

[احمد غانم]

الأخوة الكرام السلام عليكم 

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

عندي برنامج تحصيل اقساط مدرسية ارجو المساعدة في :

1- ترحيل بيانات كل ايصال يتم اصدارة في شيت (School Fee Receipt) الى شيت (Daily Report) بترتيب بحسب نموذج الجدول في شيت

Daily Report ثم حفظ نسخة من الإيصال الصادر بصيغة PDF قبل اصدار ايصال جديد

School Fee Collection System.xlsm

[حسونة حسين]

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

تفضل اخي

Option Explicit

Sub Test()
    Dim Sh As Worksheet, Ws As Worksheet, i As Long, lr As Long, DestPath
    Set Sh = ThisWorkbook.Worksheets("School Fee Receipt")
    Set Ws = ThisWorkbook.Worksheets("Daily Report")
    lr = Application.Max(5, Ws.Cells(Rows.Count, "b").End(xlUp).Row) + 1
    For i = 15 To 22
        If Sh.Cells(i, "H") <> 0 Then
            Ws.Range("B" & lr) = Sh.Range("E10")
            Ws.Range("C" & lr) = Sh.Range("E12")
            Ws.Range("D" & lr) = Sh.Range("e11")
            Ws.Range("E" & lr) = Format(Sh.Range("H9"), "[$-1010000]yyyy/mm/dd;@")
            Ws.Range("F" & lr) = Sh.Range("H10")
            Ws.Range("G" & lr) = Sh.Cells(i, "G")
            Ws.Range("H" & lr) = Sh.Cells(i, "H")
            lr = lr + 1
        End If
    Next i
    DestPath = ThisWorkbook.Path & "\" & Sh.Range("e11") & ".pdf"
    Ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestPath
End Sub

 

[احمد غانم]

16 ساعات مضت, حسونة حسين said:

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

تفضل اخي

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

اخي العزيز وضعت الكود في شيت School Fee Receipt واعطي نتيجة (حسب الصورة المرفقه) يتم ترحيل كل ايصالات الطالب 

بالنسبة للPDF المطلوب نسخة من الإيصال نفسة قبل اصدار الإيصال التالي

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

[حسونة حسين]

ممكن ملف يوضح النتائج المطلوبه

[احمد غانم]

المطلوب رجاء:عند ادخال قبض  مبلغ معين في Sheet School Collection يتم اصدار إيصال لتلميذ بتاريخة (يتم احضارة عبر رقم الطالب في القائمة النسدلة في شيت School Fee Receiptثم ترحيله الى شيت التقرير اليومي (Daily Report)  فقط ايصال اليوم(كل يوم بيومه فقط) على الإيصال عدد 8دفعات المطلوب ترحيل الدفعة الأخرة فقط ثم حفظ نسخة من الإيصال بصيغة PDF بمسار معين مع امكانية حذف البيانات قبل بدء يوم جديد و قبل تعديل البيانات لإصدار إيصال جديد لكم جزيل الشكر و التقدير

School Fee Collection System-.xlsm

[حسونة حسين]

ممكن ملف يوضح النتائج المطلوبه

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

ولو امكن شرح بالصور 

لان المطلوب الى الان غير واضح

 

[احمد غانم]

41 دقائق مضت, حسونة حسين said:

ممكن ملف يوضح النتائج المطلوبه

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

ولو امكن شرح بالصور 

لان المطلوب الى الان غير واضح

السلام عليكم

اتعبتكم مع اني احاول التوضيح قدر الإمكان

يوجد شرح داخل الملف على شيتات :School Fee Collection Sheet

                                               School Fee Receipt

                                               Daily Report

ببساطة اريد ان احفظ نسخة بصيغة PDF و تريحيل بيانات الإيصال الى التقرير اليومي تلقائيا قبل تعديل البيانات لعمل ايصال جديد.

 

School Fee Collection System-.xlsm

تم تعديل أبريل 17, 2024 بواسطه احمد غانم
تصحيح

[حسونة حسين]

جرب هذا التعديل على حسب فهمي

 

Sub Test()
    Dim Sh As Worksheet, Ws As Worksheet, i As Long, lr As Long, DestPath
    Set Sh = ThisWorkbook.Worksheets("School Fee Receipt")
    Set Ws = ThisWorkbook.Worksheets("Daily Report")
    lr = Application.Max(5, Ws.Cells(Rows.Count, "b").End(xlUp).Row) + 1
    For i = 22 To 15 Step -1
        If Sh.Cells(i, "H") <> 0 Then
            Ws.Range("B" & lr) = Sh.Range("E10")
            Ws.Range("C" & lr) = Sh.Range("E12")
            Ws.Range("D" & lr) = Sh.Range("e11")
            Ws.Range("E" & lr) = Format(Sh.Range("H9"), "[$-1010000]yyyy/mm/dd;@")
            Ws.Range("F" & lr) = Sh.Range("H10")
            Ws.Range("G" & lr) = Sh.Cells(i, "G")
            Ws.Range("H" & lr) = Sh.Cells(i, "H")
            Exit For
        End If
    Next i
    DestPath = ThisWorkbook.Path & "\" & Sh.Range("e11") & ".pdf"
    SH.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestPath
End Sub

 

[احمد غانم]

السلام عليكم اخ حسونه و بارك الله جهودك

المطلوب  ايضا ورجاء لا امر:
 حفظ نسخة من الإيصال نفسه  School Fee Receipt  بصيغة PDF بمسار معين قبل تعديل البيانات لإصدار إيصال جديد
مع امكانية حذف البيانات قبل بدء يوم جديد في شيت Daily Report --كود الحفظ في التقرير اليومي يعمل بشكل جيد شرح اضافي داخل الملف.
لك جزيل الشكر و التقدير

School Fee Collection System-.xlsm

[حسونة حسين]

2 ساعات مضت, احمد غانم said:

حفظ نسخة من الإيصال نفسه  School Fee Receipt  بصيغة PDF بمسار معين

هذه موجوده في الكود 

انسخ الكود مره اخري

[احمد غانم]

12 ساعات مضت, حسونة حسين said:

هذه موجوده في الكود 

انسخ الكود مره اخري

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

بقي مسألة اخرى لو سمحت 

كيف يمكن تغيير مسار حفظ نسخة الإيصال في  الكود الى مسار محدد مثلا(\\10.20.30.3\homedir\a.ghanem\كشف العمليات اليومية)

[حسونة حسين]

عدل 

DestPath = ThisWorkbook.Path & "\" & Sh.Range("e11") & ".pdf"

الى

DestPath = "\\10.20.30.3\homedir\a.ghanem\كشف العمليات اليومية\"  & Sh.Range("e11") & ".pdf"

 

[احمد غانم]

اتعبتك معي ارجو المعذرة

تم تعديل الكود لكن ظهرت الرسالة التالية حسب الصورة المرفقة بالإضافة الى رسالة  (File Not Saved)

تم تعديل أبريل 22, 2024 بواسطه احمد غانم
اضافة صورة

[حسونة حسين]

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

غير المسار الي اي مسار داخل جهازك ووافنا بالنتائج

[احمد غانم]

تم و لله الحمد بفضل جهودكم المباركة

لدي سؤال لو سمحت:

    DestPath = "\\10.20.30.3\homedir\a.ghanem\PDF-Recipts\" & Sh.Range("e13") & ".pdf"
هل سمكن تضمين الكود رقم الإيصال ("i12") بجانب اسم التلميذ ("e13")  ??

[حسونة حسين]

تفضل

 = "\\10.20.30.3\homedir\a.ghanem\PDF-Recipts\" & Sh.Range("e13") & "  ايصال رقم " & Sh.Range("i1") & ".pdf" 

 

[احمد غانم]

اسعد الله اوقاتكم وجزاكم كل الخير و لكم جزيل الشكر و التقدير بارككم المولى دنيا و آخرة.

 

 

[احمد غانم]

السلام عليكم اخ حسونة

الرجاء المساعدة ..لاحظت خلال استعمال الكود المرفق ادناه انة عندما يتم الترحيل من School Fee Receipt الى شيت "Daily Report"

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

لك جزيل الشكر سلفا

Sub Test()
    Dim Sh As Worksheet, Ws As Worksheet, i As Long, lr As Long, DestPath
    Set Sh = ThisWorkbook.Worksheets("School Fee Receipt")
    Set Ws = ThisWorkbook.Worksheets("Daily Report")
    lr = Application.Max(4, Ws.Cells(Rows.Count, "b").End(xlUp).Row) + 1
    For i = 22 To 15 Step -1
        If Sh.Cells(i, "H") <> 0 Then
            Ws.Range("B" & lr) = Sh.Range("E12")
            Ws.Range("C" & lr) = Sh.Range("E14")
            Ws.Range("D" & lr) = Sh.Range("e13")
            Ws.Range("E" & lr) = Format(Sh.Range("i10"), "[$-1010000]yyyy/mm/dd;@")
            Ws.Range("F" & lr) = Sh.Range("i12")
            Ws.Range("G" & lr) = Sh.Cells(i, "G")
            Ws.Range("H" & lr) = Sh.Cells(i, "H")
            Exit For
        End If
    Next i
    DestPath = "\\10.20.30.3\homedir\a.ghanem\PDF-Recipts\" & Sh.Range("e13") & "  ايصال رقم " & Sh.Range("i12") & ".pdf"
    Sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestPath
End Sub
 

[Saleh Ahmed Rabie]

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

أخي الكريم، أتفهم مشكلتك في ترحيل البيانات من شيت "School Fee Receipt" إلى شيت "Daily Report" عند استخدام الكود المرفق. إليك بعض الأسباب المحتملة لهذه المشكلة والحلول المقترحة:

**1. نطاق التكرار:**

* تأكد من أن نطاق التكرار في حلقة `For` صحيح. في الكود المرفق، يبدأ النطاق من 22 وينتهي عند 15 بخطوة -1. هذا يعني أنه سيتم تخطي الصفوف 7 و8.
* يمكنك تعديل نطاق التكرار ليشمل الصفوف التي تريد ترحيلها، على سبيل المثال: `For i = 29 To 15 Step -1`.

**2. شرط الخروج:**

* يتضمن الكود شرط خروج `Exit For` عندما يتم العثور على قيمة غير صفرية في عمود "H" في شيت "School Fee Receipt".
* إذا كانت الصفوف 7 و8 تحتويان على قيم غير صفرية في عمود "H"، فلن يتم ترحيلها لأن شرط الخروج سيتم تنفيذه قبل الوصول إليها.
* يمكنك إزالة شرط الخروج أو تعديله للسماح بترحيل جميع الصفوف التي تحتوي على قيم غير صفرية في عمود "H".

**3. أخطاء النطاق:**

* تحقق من صحة نطاقات الخلايا المستخدمة في الكود. تأكد من أنك تشير إلى الخلايا الصحيحة في كلا الشيتين.
* يمكنك استخدام أداة "التحقق من الأخطاء" في Excel لتحديد أي أخطاء في النطاقات.

**4. تنسيق البيانات:**

* تأكد من أن تنسيق البيانات في عمود "H" في شيت "School Fee Receipt" متسق. إذا كانت بعض القيم نصية والبعض الآخر أرقام، فقد يؤدي ذلك إلى حدوث مشكلات في الترحيل.
* يمكنك استخدام دالة `ISNUMBER` للتحقق من تنسيق البيانات وإجراء التعديلات اللازمة.

**5. تحديث الكود:**

* إذا لم تحل أي من الحلول المقترحة المشكلة، فقد تحتاج إلى تحديث الكود. يمكنك تجربة استخدام حلقة `Do While` بدلاً من حلقة `For`، أو استخدام طريقة `Find` للبحث عن الصفوف التي تحتوي على قيم غير صفرية في عمود "H".

 

[Saleh Ahmed Rabie]

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

أخي الكريم،

لقد راجعت الكود الذي قدمته ووجدت المشكلة في حلقة `For` التي تستخدم للبحث عن الدفعة الأخيرة التي تم دفعها. حيث تبدأ الحلقة من الصف 22 وتنتهي عند الصف 15 بخطوة -1. وهذا يعني أن الحلقة ستتخطى الصفوف 16 و17 و18، والتي قد تحتوي على دفعات تم دفعها.

لتصحيح هذه المشكلة، يجب تعديل حلقة `For` لتبدأ من الصف 24 بدلاً من الصف 22، كما يلي:

```
For i = 24 To 15 Step -1
```

إليك الكود المعدل:

Sub Test()
    Dim Sh As Worksheet, Ws As Worksheet, i As Long, lr As Long, DestPath
    Set Sh = ThisWorkbook.Worksheets("School Fee Receipt")
    Set Ws = ThisWorkbook.Worksheets("Daily Report")
    lr = Application.Max(4, Ws.Cells(Rows.Count, "b").End(xlUp).Row) + 1
    For i = 24 To 15 Step -1
        If Sh.Cells(i, "H") <> 0 Then
            Ws.Range("B" & lr) = Sh.Range("E12")
            Ws.Range("C" & lr) = Sh.Range("E14")
            Ws.Range("D" & lr) = Sh.Range("e13")
            Ws.Range("E" & lr) = Format(Sh.Range("i10"), "[$-1010000]yyyy/mm/dd;@")
            Ws.Range("F" & lr) = Sh.Range("i12")
            Ws.Range("G" & lr) = Sh.Cells(i, "G")
            Ws.Range("H" & lr) = Sh.Cells(i, "H")
            Exit For
        End If
    Next i
    DestPath = "\\10.20.30.3\homedir\a.ghanem\PDF-Recipts\" & Sh.Range("e13") & "  ايصال رقم " & Sh.Range("i12") & ".pdf"
    Sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestPath
End Sub

بعد إجراء هذا التعديل، سيعمل الكود بشكل صحيح وسيقوم بترحيل جميع الدفعات إلى شيت "Daily Report"، بما في ذلك الدفعات السابعة والثامنة.

 

 

[احمد غانم]

3 ساعات مضت, 2024 said:

* تأكد من أن نطاق التكرار في حلقة `For` صحيح. في الكود المرفق، يبدأ النطاق من 22 وينتهي عند 15 بخطوة -1. هذا يعني أنه سيتم تخطي الصفوف 7 و8.
* يمكنك تعديل نطاق التكرار ليشمل الصفوف التي تريد ترحيلها، على سبيل المثال: `For i = 29 To 15 Step -1`

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

 

[حسونة حسين]

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

 عدد 8دفعات المطلوب ترحيل الدفعة الأخرة فقط

ونطاق الدفعات من السطر 15 الي السطر 22

كما بالصورة التالية

 

[احمد غانم]

السلام عليكم اخي الكريم

صحيح الكود ممتاز و يعمل بشكل جيد لكن اقتربنا من نهاية العام الدراسي وعند تحصيل اي من الدعات 7 و 8 لا تظهر في شيت Daily Report فقط

اشكر اهتمامكم

 

[حسونة حسين]

29 دقائق مضت, احمد غانم said:

وعند تحصيل اي من الدعات 7 و 8 لا تظهر في شيت Daily Report فقط

التحصيل يظهر وليس به مشكله سواء 7 او 8

 

School Fee Collection لystem-.xlsm