كيف يتم الترحيل بالكود لهذه القيود بشرط

[ابو اياد ( الاسيوطى )]

السلام عليكم

كيف حالكم اخوتى فى الله اتمنى من الله ان تكونوا بخير

 

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

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

ولكن هناك بعض التحفظات على هذا الترحيل

 

اولا : لا يتم الترحيل ألا اذا كان اجمالى طرفى القيد متساويين المدين = الدائن

اى زر الترحيل لا يكون نشط إلا فى هذه الحاله فقط

 

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

 

ثالثا : فوق زر الترحيل معادله بسيطه وتنسيق شرطى بسيط يساعدا مدخل البيانات او المحاسب على لفت نظره الى حاله القيد مما يفيد

تمكينه من الترحيل او عدمه

 

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

واتمنى ان يكون التنفيذ بكود بسيط وسريع حتى يتسنى لى تعلمه وبارك الله فيكم

 

وحتى ننتقل الى مطلوب غيره انتظركم

 

 

مثال على الترحيل.rar

[حمادة عمر]

السلام عليكم

الاخ الحبيب / محمود الاسيوطى

بارك الله فيك

ضع الكود التالي في حدث الشيت Entry  بالشكل التالي ليجعل الزر نشط او غير نشط لتنفيذ عملية الترحيل

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("f14").Value = "يمكنك الترحيل" Then
CommandButton1.Enabled = True
ElseIf Range("f14").Value = "لا يمكنك الترحيل" Or Range("f14").Value = "ادخل بياناتك" Then
CommandButton1.Enabled = False
End If
End Sub

وقم بوضع الكود التالي في حدث زر الترحيل

Private Sub CommandButton1_Click()
Dim ws, ws1 As Worksheet
Dim LR, LR1 As Long
Dim iRow As Long
Set ws = Worksheets("Database")
Set ws1 = Worksheets("Entry")

LR = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
ws.Cells(LR, 4).Value = ws1.[d14].Value
ws.Cells(LR, 5).Value = ws1.[d15].Value
ws.Cells(LR, 6).Value = ws1.[d16].Value

ws1.Range("C20:F40").Copy
ws.Select
LR1 = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
ws.Cells(LR1, 7).Select
ws.Paste
ws.[d3].Select

MsgBox "الحمد لله... تم ترحيل القيد بنجاح"
ws1.Select
Range("C18").Select
    Application.CutCopyMode = False

End Sub

تقبل خالص تحياتي

 

مثال على الترحيل-SAMA.rar

[ابو اياد ( الاسيوطى )]

السلام عليكم

استاذى الجميل // حماده عمر ( رحم الله والدك وادخله فسيح جناته )

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

بالرغم من ذلك وقفت امامى اشياء لم افهمها حتى حاولت التعديل ولم افلح برغم من فهمى بعض الشىء

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

 

بدايه كان هناك خطأ منى فى شيت entry آلا وهو 14 صف مخفى بدون قصد ولكن جت لصاحنا تم ألغائهم ولم اعرف ان احافظ على الترحيل

 

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

 

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

الترحيل للتاريخ ورقم القيد والشرح يكون لجميع صفوف القيد اى بصف كل المبالغ التى دخلت فى القيد حتى يتسنى لى بعد ذلك

استدعاء القيود سواء بالرقم او تاريخ اليوم

 

لا اريد الذهاب الى شيت قاعده البيانات بعد الترحيل

شرط اخر لا يتم الترحيل إلا اذا قد تم ادخال التاريخ ورقم القيد ( الغير متكرر ) وشرح القيد

 

مع العلم قمت بمنع المدخل من ادخال رقم قيد تم ادخاله من فبل

 

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

مثال على الترحيل-SAMA1.rar

[saad abed]

اخى محمود 

بعد اذن مشرفنا حماده عمر  وارجو ان يعلف على الكود بما له وبما عليه 

جرب الكود التالى

فقد راعيت فيه ثلاث شروط

الا تكون البيانات فارغة الا يتكرر رقم القيد ان يكون متوازن

هذا فى اطار التدريب على صنع الاكواد فالتمس لى العذر ان لم يؤدى الهدف المنشود

مثال على الترحيل.rar

تم تعديل فبراير 28, 2014 بواسطه سعد عابد

[ابو اياد ( الاسيوطى )]

السلام عليكم

 

استاذى الكبير // سعد عابد

 

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

استاذى جرب ادخال قيد اخر ثم جرب ترحيله ،،،،، لم يقم بالترحيل معى ويخبرنى بأن رقم القيد متكرر او القيد غير منضبط

 

انتظرك

[saad abed]

اخى محمود

تم تعديل الكود جرب واعلمنى

تحياتى

Sub saad()
Application.ScreenUpdating = False
Sheets("Entry").Select
al = Sheets("Database").[e10000].End(xlUp).Row
If [d1] = "" Or [d2] = "" Or [d3] = "" Then
MsgBox "Ãßãá ÇáÈíÇäÇÊ ÃæáÇ"
Exit Sub
ElseIf Not [c4].Value = [d4].Value Then
MsgBox "!ÊÃßÏ ãä ÅÏÎÇá ÇáÞíÏ ãÚ ÊæÇÒä ÇáØÑÝíä", vbExclamation, "ÅÏÎÇá ÎÇØÆ"
Exit Sub
ElseIf Sheets("Database").Range("e" & al).Value = [d2].Value Then
MsgBox "!ÊÃßÏ ãä ÚÏã ÊßÑÇÑ ÇáÝíÏ", vbExclamation, "ÅÏÎÇá ÎÇØÆ"
Exit Sub
'Else
End If
For r = 7 To Sheets("Entry").[c3000].End(xlUp).Row
    With Sheets("Database").[d10000].End(xlUp)
        .Offset(1, 0) = Sheets("Entry").[d1].Value
        .Offset(1, 1) = Sheets("Entry").[d2].Value
        .Offset(1, 2) = Sheets("Entry").[d3].Value
        .Offset(1, 3) = Sheets("Entry").Cells(r, 3)
        .Offset(1, 4) = Sheets("Entry").Cells(r, 4)
        .Offset(1, 5) = Sheets("Entry").Cells(r, 5)
        .Offset(1, 6) = Sheets("Entry").Cells(r, 6)
        
End With
Next r
Application.ScreenUpdating = True
End Sub

مثال على الترحيل.rar

[ابو اياد ( الاسيوطى )]

السلام عليكم

استاذى الكبير // سعد عابد

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

والان يتم النرحيل كما يجب ان يكون

ولكن لم يكتمل ما اريد وهو

 

1- ان تظهر رساله تأكيد هل ترغب بترحيل القيد الاجابه تكون كما يلى ( yes )    او ( continue editing )

2- اذا اخترنا  ( continue editing )  يدعنا نكمل الادخال

3-  اذا اخترنا الاجابه ( yes ) يتم الترحيل اولا ثم  مسح جميع الخلايا المملؤه ببيانات مثل التاريخ ورقم القيد وشرح القيد وايه بيانات اخرى مدخله ( تم اعطاء الخلايا المراد مسح بياناتها اللون الاخضر )

4- تظهر رساله تفيد ترحيل القيد

 

ارجو ان يكون المطلوب واضح واتمنى ايضا ان يكون سهل التنفيذ حتى يتسنى لى فهمه وآلا اكون اثقلت عليك

 

تقبل تحياتى فى انتظارك

 

ارجو التنفيذ على المرفق

سعد عابد2.rar

[ابو اياد ( الاسيوطى )]

up

[أبو حنــــين]

السلام عليكم

يصبح كود الأخ سعد بهذه الطريقة

Sub saad()

Application.ScreenUpdating = False
Sheets("Entry").Select
al = Sheets("Database").[e10000].End(xlUp).Row
If [d1] = "" Or [d2] = "" Or [d3] = "" Then
MsgBox "أكمل البيانات أولا"
Exit Sub
ElseIf Not [c4].Value = [d4].Value Then
MsgBox "!تأكد من إدخال القيد مع توازن الطرفين", vbExclamation, "إدخال خاطئ"
Exit Sub
ElseIf Sheets("Database").Range("e" & al).Value = [d2].Value Then
MsgBox "!تأكد من عدم تكرار الفيد", vbExclamation, "إدخال خاطئ"
Exit Sub
'Else
End If
If MsgBox("هل تريد ترحيل البيانات الحالية", vbInformation + vbOKCancel, "ترحيل") = vbCancel Then Exit Sub
For r = 7 To Sheets("Entry").[c40].End(xlUp).Row
    With Sheets("Database").[d3005].End(xlUp)
        .Offset(1, 0) = Sheets("Entry").[d1].Value
        .Offset(1, 1) = Sheets("Entry").[d2].Value
        .Offset(1, 2) = Sheets("Entry").[d3].Value
        .Offset(1, 3) = Sheets("Entry").Cells(r, 3)
        .Offset(1, 4) = Sheets("Entry").Cells(r, 4)
        .Offset(1, 5) = Sheets("Entry").Cells(r, 5)
        .Offset(1, 6) = Sheets("Entry").Cells(r, 6)
        
End With


Next r
With Sheets("Entry")
MsgBox "تم ترحيل السند رقم  " & .Range("D2") & "  بنجاح", vbInformation, ""
.Range("C7:F40") = ""
.Range("D1:D3") = ""
End With

Application.ScreenUpdating = True


End Sub

و اجو المعذرة من اخي سعد

[أحمد عبدالعزيز]

الأستاذ / محمود الأسيوطى
حقاً أنت رجل صعيدى و جدع و الأهم أنك رجل خيِّر 
تحياتى إليك على كل مواضيعك الموجوده على توقيعك 
منذ فترةٍ طويله لم أدخل على هذا المنتدى و لكن أنت من أوائل من أتفقد أعمالهم نظراً لمواضيعك القيمه و ذوقك الرفيع 
الشكر كل الشكر لك أخى الكريم

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

[saad abed]

اخى  الحبيب ابوحنين

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

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

ولى الشرف وافتخر انك احد الاساتذه الذين اسجل اكوادهم  لا اتعلم منها كيف افكر فى بناء الكود

تحياتى لكم

[حمادة عمر]

السلام عليكم

مشاركات راائعة وروح عاليه  تجعل المنتدي اكثر رونقا وجمالا

 

اخي الحبيب /  محمود الاسيوطى

دائما تقدم مواضيع جميله تجمع فيها الاحبه 

 

الاخ الحبيب /  سعد عابد  .... القادم بقوه

الاستاذ الحبيب  الي قلبي جدا /  أبو حنين ... دائما مشاركاتك او حتي كلماتك تضيف لدي الجميع

 

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

تقبلوا خالص تحياتي

[أبو حنــــين]

اخي الحبيب سعد

اخي الحبيب ابو سما

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

و كما يقول الشيخ الابراهيمي : هكذا كونو أو لا تكونو

و في ما ورد في حديثه أيضا مخاطبا الشباب :

.............

أتمثله مقداما على العظائم في غير تهوّر، محجامًا عن الصغائر في غير جبن، مقدرًا موقع الرجل قبل الخطو، جاعلا أول الفكر آخر العمل.

أتمثله واسع الوجود، لا تقف أمامه الحدود، يرى كل عربي أخًا له، أخوة الدم، وكلَّ مسلم أخًا له، أخوة الدين، وكل بشر أخًا له، أخوة الإنسانية، ثم يُعطي لكل أخوة حقها فضلا أو عدلا.

أتمثله حليف عمل، لا حليف بطالة، و جليس معمل، لا جليس مقهى، وبطل أعمال، لا ماضغَ أقوال، ومرتاد حقيقة، لا رائد خيال.

 

[ابو اياد ( الاسيوطى )]

السلام عليكم

اخوتى واحبائى ( والله احبكم جميعا فى الله ولله ) جميع اعضاء المنتدى الرائع الذى اخذنى من عالم النت جميعا واحتقرنى سواء كنت سائلا ام مساعدا

 

الحمد لله والفضل لله تم تنفيذ المطلوب الاول بأحترافيه وسد جميع ثغراته ( من وجه نظرى ان لم يكن احد له رأى اخر )

هناك شئ بسيط تظهر الحروف العربيه بالكود وفى الرسائل علامه أستفهام ؟؟؟؟؟؟؟؟؟؟؟؟ لا اعلم لماذا

واود ان ارى تقيمكم للموضوع بعد ان صنعه استاذى // حماده عمر واستاذى // سعد عابد وقام بالضربه القاضيه استاذى // ابو حنين

 

لكم جزيل الشكر والعرفان فعلا عمل رائع من اعضاء وخبراء ومشرفين اروع

سعد عابد2.rar

[ابو اياد ( الاسيوطى )]

شكرا وعرفانا

استاذنا // ابو حنين ( انت فعلا انسان جميل ورائع واحساسك بأخوانك عالى ومرهف ) ( كلماتك صعبه شويه اريد التركيز فيها اكثر جميله )

استاذى // سعد عابد ( انسان رائع تساعدنا قدر استطاعتك ولكنى اعلم ان لم تكن الضربه القاضيه للثغره من استاذى ابو حنين لكانت منك ) ولكنك صانعها ههههههه

بارك الله فيك

استاذى // حماده عمر ( الجميل ) مجرد ردك او مشاركتك فى موضوع يصير له عطرا جميلا هذا العطر يعكس روحكم الجميله ( رحم الله والدك ونسأل الجميع الفاتحه له )

 

تقبلوا تحياتى 

[حمادة عمر]

هناك شئ بسيط تظهر الحروف العربيه بالكود وفى الرسائل علامه أستفهام ؟؟؟؟؟؟؟؟؟؟؟؟ لا اعلم لماذا

 

بالنسبة لهذ الموضوع اخي الحبيب

راجع الرابط التالي ... سيفدك في هذا الامر باذن الله

http://www.officena.net/ib/index.php?showtopic=47426&hl=%2B%D9%85%D8%AD%D8%B1%D8%B1+%2B%D8%A7%D9%84%D8%A7%D9%83%D9%88%D8%A7%D8%AF#entry286234

 

تقبل خالص تحياتي

[حمادة عمر]

 

استاذى // حماده عمر ... ( رحم الله والدك ونسأل الجميع الفاتحه له )

 

اللهم آمين  ....

آمين ....

آمين ....

[أبو عبد الرحمن سعيد]

هناك شئ بسيط تظهر الحروف العربيه بالكود وفى الرسائل علامه أستفهام ؟؟؟؟؟؟؟؟؟؟؟؟ لا اعلم لماذا

اخى العزيز المحترم // ابواياد 

السلام عليكم

بشأن علامات الاستفهام 

قم بتغييرلغة الجهازالى اللغة العربية

ثم نسخ الكود المشاراليه عاليا ثم لصقه

والشكرلجميع الساده الزملاء الافاضل

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

تم تعديل مارس 2, 2014 بواسطه سعيد بيرم

[ابو اياد ( الاسيوطى )]

لا تزال المشكله قائمه ( الكود لا يقرأ اللغه العربيه صحيحه يقرأها علامه استفهام ؟؟؟؟؟؟؟؟؟؟؟؟ ) 

 

مع العلم هناك اكواد اخرى تقرأ اللغه العربيه صحيحه بجهازى

 

الملف مرفق بالمشاركه 14#

[أبو عبد الرحمن سعيد]

الملف يعمل بطريقه ممتازة

اذن اين المشكلة ؟

[ابو اياد ( الاسيوطى )]

الحمد لله تمام تم التغلب على المشكله

 

وشكرا للجميع على مشاركتهم الرائعه

 

قمت بكتابه الجمل العربيه داخل الكود من الاول وعملت بشكل سليم 100%

 

بارك الله فيكم

[أبو عبد الرحمن سعيد]

الحمد لله الذى بنعمته تتم الصالحات

تم تعديل مارس 2, 2014 بواسطه سعيد بيرم

[saad abed]

اخي الحبيب سعد

اخي الحبيب ابو سما

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

و كما يقول الشيخ الابراهيمي : هكذا كونو أو لا تكونو

و في ما ورد في حديثه أيضا مخاطبا الشباب :

.............

أتمثله مقداما على العظائم في غير تهوّر، محجامًا عن الصغائر في غير جبن، مقدرًا موقع الرجل قبل الخطو، جاعلا أول الفكر آخر العمل.

أتمثله واسع الوجود، لا تقف أمامه الحدود، يرى كل عربي أخًا له، أخوة الدم، وكلَّ مسلم أخًا له، أخوة الدين، وكل بشر أخًا له، أخوة الإنسانية، ثم يُعطي لكل أخوة حقها فضلا أو عدلا.

أتمثله حليف عمل، لا حليف بطالة، و جليس معمل، لا جليس مقهى، وبطل أعمال، لا ماضغَ أقوال، ومرتاد حقيقة، لا رائد خيال.

اخى ابوحنين

بعد ما قرات ردكم

تمنيت ان كل عربى او كل مسلم او كل انسان على هذه الارض ان يقرأها

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

تم تعديل مارس 2, 2014 بواسطه سعد عابد

[أبو حنــــين]

الحمد لله

و الشكر موصول للجميع و لكل من ساهم او عقب على هذا الموضوع

بارك الله فيكم

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

[ابو اياد ( الاسيوطى )]

الأستاذ / محمود الأسيوطى

حقاً أنت رجل صعيدى و جدع و الأهم أنك رجل خيِّر 

تحياتى إليك على كل مواضيعك الموجوده على توقيعك 

منذ فترةٍ طويله لم أدخل على هذا المنتدى و لكن أنت من أوائل من أتفقد أعمالهم نظراً لمواضيعك القيمه و ذوقك الرفيع 

الشكر كل الشكر لك أخى الكريم

أخوك / أحمد عبدالعزيز 

لنلتقى على صفحة : المحاسبه بكل بساطه على الفيس بوك

تحيااااااااااااااتى لك

 

اخى العزيز // ARABYS

بارك الله فيك على كلماتك الرائعه ووالله انت ايضا محترم وكريم

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

تقبل تحياتى ولكن لى رجاء عندك كما قالها من قبلى استاذنا ملك المعادلات // ابو محمود

حضرتك عضو قديم والاحرى بك ان تكون قدوه للأعضاء الجدد ارجو تغير اسمك للعربيه فيجب علينا ان نعتز بها

ارجو ألا تسئ الفهم فهذا رجاء ولن يلومك احد ان لم تأخذ به