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

[احمد غانم]

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

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

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

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

تم تعديل April 17 بواسطه احمد غانم
تصحيح

[حسونة حسين]

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

 

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)

تم تعديل الإثنين at 10:10 بواسطه احمد غانم
اضافة صورة

[حسونة حسين]

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

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

[احمد غانم]

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

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

    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" 

 

[احمد غانم]

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