احتاج ترحيل ملف سند قبض إلى ملف أخر اسمه حسابات

[onlymanly]

السادة خبرا المنتدى,,,,,,

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

إلى ملف اخر بموجب أرقام الحسابات..

و انا احتاج و الله هذا الشي... صحيح أن الذي بيساعدني بيعمل عمل كبير سيما و أني في أمس الحاجة ..

ارفقت لكم الملفين أرجو التعاون

[طارق محمود]

السلام عليكم

بدأت بالعمل علي المطلوب

لكن للأسف بخطأ في الكمبيوتر ضاعت الملفات سأبدأمن الأول يوم السبت إن لم يحلها لك أحد الأخوة

[وائل مراد 700]

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

كل الشكر لك أخي طارق

[onlymanly]

أستاذنا طارق الحمد لله ع سلامتك....

و ما أدري اش اقول لك بالنسبة للطفك و جودك مع كل الإخوة.. غير فرج الله عنا و عنك كربات يوم القيامة.

[خالد القدس]

السلام عليكم أستاذ طارق ألف حمداً لله على سلامتك وعودة مباركة ونحن معشر التلاميذ في إنتظار درس الترحيل الشيق من أستاذ منمكن جزاك الله عنا خير الجزاء

[طارق محمود]

السلام عليكم

تفضل المرفق وسأشرح لك قريبا

Only.rar

[طارق محمود]

هذا هو الماكرو المستخدم

Sub shift()

Dim xxx As String


s_qabd = Range("F2").Value

s_name1 = Range("H5").Value

s_name2 = Range("L10").Value

s_acc1 = Range("F5").Value

s_acc2 = Range("M9").Value

s_explain = Range("S1").Value

s_from = Range("S2").Value

s_to = Range("S3").Value

s_kind = Range("F2").Value

s_amount = Range("F7").Value

s_date = Range("D3").Value


Range(" F5 , M9 , F7 , D3").Select

Selection.ClearContents



'   Check if is Open or Close, so open if close

a = Workbooks.Count

ActiveCell.Offset(1, 0).Value = a

    x = "Close"

    For i = 1 To a

        If Workbooks(i).Name = "Accounts.xls" Then x = "OPEN"

    Next i

    If x = "Close" Then xxx = ActiveWorkbook.Path & "\" & "Accounts.xls": Workbooks.Open xxx



 Windows("Accounts.xls").Activate



' Shift the Dedit ACC

x = Worksheets.Count

    For i = 1 To x

        If Worksheets(i).Name = s_name1 Then GoTo 100

    Next i


    Sheets("Sample").Select

    Sheets("Sample").Copy Before:=Sheets(1)

    ActiveSheet.Name = s_name1


    Range("B2").Value = s_acc1

    Range("E4").Value = s_name1


'     zz = Worksheets(i).Name

100


Worksheets(s_name1).Select

Range("a1000").Select

Selection.End(xlUp).Select

    If ActiveCell.Row = 7 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 2).Value = s_amount

ActiveCell.Offset(0, 5).Value = s_date

ActiveCell.Offset(0, 6).Value = s_kind

ActiveCell.Offset(0, 8).Value = s_to & s_name2


        'Al-Raseed BALANCE of Debit ACC

If ser = 1 Then ActiveCell.Offset(0, 3).FormulaR1C1 = "=RC[-1]": GoTo 150


        ActiveCell.Offset(0, 3).FormulaR1C1 = "=R[-1]C+RC[-1]-RC[-2]"

150



' Shift the Credit ACC

x = Worksheets.Count

    For i = 1 To x

        If Worksheets(i).Name = s_name2 Then GoTo 200

    Next i


    Sheets("Sample").Select

    Sheets("Sample").Copy Before:=Sheets(1)

    ActiveSheet.Name = s_name2


    Range("B2").Value = s_acc2

    Range("E4").Value = s_name2


200

Worksheets(s_name2).Select

Range("a1000").Select

Selection.End(xlUp).Select

    If ActiveCell.Row = 7 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount

ActiveCell.Offset(0, 5).Value = s_date

ActiveCell.Offset(0, 4).Value = s_explain

ActiveCell.Offset(0, 8).Value = s_from & s_name1


        'Al-Raseed BALANCE of Credit ACC

If ser = 1 Then ActiveCell.Offset(0, 3).FormulaR1C1 = "=-RC[-2]": GoTo 250


        ActiveCell.Offset(0, 3).FormulaR1C1 = "=R[-1]C+RC[-1]-RC[-2]"

250



 Windows("QABD.xls").Activate

 Range("d3").Select

End Sub

[طارق محمود]

السلام عليكم

بعض الملاحظات والتغييرات

إضررت لتغيير أسماء الملفات للغة الإنجليزية لعيب مع اللغة العربية في النظام عندي

جعلت إختيار إسم العميل أو البنك أوتوماتيك من قائمة منسدلة في كلتا حالتي الدائن والمدين

بمعني أنه الأفضل أن تضع بيانات رقم الحساب والإسم في المجال منAA3 إلي AB22 (لونه أصفر)

في حالة أن الإسم غير موجود في ملف الحسابات "Accounts.xls" فسيتم أوتوماتيك عمل ورقة جديدة بالإسم الجديد

يقوم الماكرو بعمل تحقيق أوتوماتيك إن كان ملف الحسابات "Accounts.xls" مفتوح وإلا يفتحه

ثم الرجوع مرة أخري إلي ملف سند القبض

أيضا تم تعديل المعادلة الخاصة بالرصيد لتعطي سالب إذا كان الرصيد مدين

يكتب في خانة الملاحظات أن المبلغ من ح/ فلان أو إلي ح/ فلان

ملاحظة:

1. موضوع إذا كان الإيداع نقدي فتختار أنت رقم حساب الصندوق يدويا أفضل لكيلا يتعارض مع الماكرو

2. يوجد في الخلايا S1,S2,S3 بعض العبارات (عملية قبض - من ح/ - إلي ح/ ) أستخدمها في الماكرو لنفس العيب مع اللغة العربية عندي فلا تلغيها

3. المبلغ كتابة لايتم أوتوماتيك أيضا عليك عمله

4. بعد الترحيل يتم تفريغ بيانات الحقول :التاريخ / رقم حساب الدائن /رقم الحساب المدين / المبلغ من ملف سند القبض "QABD.xls"

ولاتنزعج لرسالة الخطأ في حقلي إسم الحساب الدائن ، إسم الحساب المدين

سيتلاشي الخطأ بعد ملئ رقم الحساب

[أبوعبد الله]

أخي العزيز / طارق

تقبل تحياتي وتقديري على هذا العمل المميز فجزاك الله خيراً.

أبو عبدالله

[onlymanly]

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

اشكرك أستاذي طارق ع مجهودك .. و نعم الملف .. اشكرك كثيرا

[طارق محمود]

أخي العزيز / طارق

تقبل تحياتي وتقديري على هذا العمل المميز فجزاك الله خيراً.

أبو عبدالله

السلام عليكم

أخي وأستاذي أبو عبدالله

هذا شرف والله أن تعلق علي الموضوع بمثل هذا التعليق

أكيد هذا جزء مما تعلمناه منكم

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

[طارق محمود]

أخي العزيز onlymanly

لاشكر علي واجب

نفعنا الله وإياكم بما نعلم وبما نعمل

[onlymanly]

عدلت بعض الشي كما في المرفق.

أتمنى أن يساعدني أحد ليعمل التعديل ع ما يرام .. و بارك الله في الجميع

Only.rar