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

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

احمد غانم
 مشاركة
إذهب إلى أفضل إجابة Solved by حسونة حسين,

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

احمد غانم

احمد غانم

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

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

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

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

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

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

School Fee Collection System.xlsm

رابط هذا التعليق
شارك
  • حسونة حسين changed the title to ترحيل بيانات الإيصالات الى التقرير اليومي
  • 3 weeks later...
حسونة حسين

حسونة حسين

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

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

تفضل اخي 

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 المطلوب نسخة من الإيصال نفسة قبل اصدار الإيصال التالي

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

Screenshot 2024-04-16 073417.png

رابط هذا التعليق
شارك
احمد غانم

احمد غانم

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

المطلوب رجاء:عند ادخال قبض  مبلغ معين

في 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

تم تعديل بواسطه احمد غانم
تصحيح
رابط هذا التعليق
شارك
  • أفضل إجابة
حسونة حسين

حسونة حسين

قام بنشر
  • أفضل إجابة
قام بنشر

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

  

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

 

  • Like 1
رابط هذا التعليق
شارك
احمد غانم

احمد غانم

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

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

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

School Fee Collection System-.xlsm

رابط هذا التعليق
شارك
  • بن علية حاجي changed the title to ترحيل بيانات الإيصالات إلى التقرير اليومي
احمد غانم

احمد غانم

قام بنشر
  • الكاتب
قام بنشر
12 ساعات مضت, حسونة حسين said:

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

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

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

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

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

رابط هذا التعليق
شارك
احمد غانم

احمد غانم

قام بنشر
  • الكاتب
قام بنشر (معدل)

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

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

Capture.PNG

Capture2.PNG

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

احمد غانم

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

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

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

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

رابط هذا التعليق
شارك
  • 1 month later...
احمد غانم

احمد غانم

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

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

الرجاء المساعدة ..لاحظت خلال استعمال الكود المرفق ادناه انة عندما يتم الترحيل من 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

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

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`

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

 

  • Thanks 1
رابط هذا التعليق
شارك
حسونة حسين

حسونة حسين

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

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

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

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

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

1.png.3648e6c71cb035c39d93a5b816c0cd42.png


 

رابط هذا التعليق
شارك
احمد غانم

احمد غانم

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

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

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

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

 

1.png.3648e6c71cb035c39d93a5b816c0cd42.png

رابط هذا التعليق
شارك
حسونة حسين

حسونة حسين

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

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

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

 

School Fee Collection لystem-.xlsm

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

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

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



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept