سلسلة علمنى كيف اصطاد - الترحيل

[سيف الدين حسام]

الصقر الجريـح

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

 

لكن الترحيل هلى اساس نقدا - او شيكات - كذلك السيريال ( الترقيم التلقائى للايصالات ) -  ممكن توضيح

تم تعديل يناير 6, 2015 بواسطه سيف الدين حسام

[الصـقر]

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

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

تقبل تحياتى

[KHMB]

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

شكرا الأخ حسام عيسى وسلامات ايه اللي جرحك

طبقت نفس الموضوع  فعند الترحيل يعطينى رسالة رقم 424 الكائن مطلوب Object Required بعدها نزلت مثالك واشتغل تمام ما ادري ايش المشكلة

[الصـقر]

اخى الكريم 

 

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

شكرا الأخ حسام عيسى وسلامات ايه اللي جرحك

طبقت نفس الموضوع  فعند الترحيل يعطينى رسالة رقم 424 الكائن مطلوب Object Required بعدها نزلت مثالك واشتغل تمام ما ادري ايش المشكلة

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

تقبل تحياتى

[KHMB]

السلام عليم ورحمة الله

طبقت علي الدرس الأول فقط

 

مرفق

الدرس الاول فقط.rar

[سيف الدين حسام]

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

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

تقبل تحياتى

أخى الكريم الصقر الجريح

قال الله تعالى فى سورة الانبياء الاية 37 

( خُلِقَ الْإِنسَانُ مِنْ عَجَلٍ ۚ سَأُرِيكُمْ آيَاتِي فَلَا تَسْتَعْجِلُونِ  )

فلا تتعجب لعجلى

تقبل تحياتى ولا تيأس منى

[الصـقر]

السلام عليم ورحمة الله

طبقت علي الدرس الأول فقط

 

مرفق

اخى الكريم اللى مش عارفه اسمه

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

ثانيا شكر خاص لحضرتك لحرصك على التعلم والاصرار علية 

بخصوص اين الخطا بالكود 

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

Sub Tarheel()
Dim LR As Integer
Application.ScreenUpdating = False
With sheet2
LR = .Cells(.Row.Count, "D").End(xlUp).Row
.Cells(LR + 1, "D") = [E6]
.Cells(LR + 1, "E") = [H6]
.Cells(LR + 1, "F") = [K6]
.Cells(LR + 1, "G") = [E10]
.Cells(LR + 1, "H") = [H10]
.Cells(LR + 1, "i") = [K10]
[E6] = ""
 [H6] = ""
 [K6] = ""
 [E10] = ""
 [H10] = ""
 [K10] = ""
 End With
End Sub

الخطاء هنا 

 اولا : هو هذا السطر 

LR = .Cells(.Row.Count, "D").End(xlUp).Row

يتم تعديله الى 

LR = .Cells(.Rows.Count, "D").End(xlUp).Row

الفرق هو Rows بدلا من RoW

ثانيا : هذا السطر

With sheet2

وتعديله هو

With ورقة2

لو رجعت للشرح وشوف الصورة دى هتجد اننا استخدمنا sheet4  وهى خارج القوس 

 

 

لماذا لان الاوفيس عندك عربى والاصل لأسماء الشيتات بمحرر الاكواد العربية ملكش دعوه بالاسم اللى داخل القوس استخدم دائما وابدا الاسم خارج القوس لو جربت تعدل اسم sheet2 بالمرفق وادخل محرر الاكود ستجد برضوا اسمه ورقة2

ثالثا: هذا السطر

Dim LR As Integer

وجوده او عدم وجوده لا يؤثر فى شئ

 

رابعا : اعجاب

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

[E6] = ""
 [H6] = ""
 [K6] = ""
 [E10] = ""
 [H10] = ""
 [K10] = ""

تقبل تحياتى وشكرا لحضرتك مره اخرى

[KHMB]

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

الله يبارك فيك اخي حسام

طيب من المفترض انة تعمل With مع الاسم الاخر هل هذا ثابت لانني اتعامل في اسناد WS وغيرها.

 

اخيك / أبو الحسن والحسين

[شوقي ربيع]

السلام عليكم

بارك الله فيك وجازك كل الخير اخي الصقر الجريح

عندي تعقيب بسيط على الموضوع ارجو ان تتقبله بصدر رحب لانه لاغاية لي الى اثراء الموضوع

اولا عندما نعطل احد وضائف المصنف مثلا كود تثبيت الشاشة

Application.ScreenUpdating = False

من الافضل ارجاعه الى وظيفته الافتراضية عند نهاية الكود

Application.ScreenUpdating = True

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

  lr = .Cells(.Rows.Count, "D").End(xlUp).Row + 1

ثالث هنا عملية الترحيل بسيطة وليس فيها الكثير من البيانات

فرضا انه لدينا بيانات كثيرة سترحل سيكون من الافضل استخدام الحلاقات الدورانية لتنفيذ المطلوب

لاكن في المثال السابق ليس من المستحسن استخدامها لان ترتيب البيانات المرحلة متخالف مع المرحل اليها انما سيربكنا استعمالها

لذى افضل استخدام المصفوفات التي تتسم بالسرعة الفائقة في التنفيذ و اختزال الاسطر الكثيرة

ليكون المثال السابق كالاتي

Sub ترحيل()
Application.ScreenUpdating = False
With Sheet4
  lr = .Cells(.Rows.Count, "D").End(xlUp).Row + 1
  ' مصفوفة تحوي البيانات التي سترحل حسب ترتب الترحيل
  Dim Matrix: Matrix = Array([D8], [G7], "", [D10], "=R[-1]C+RC[2]-RC[1]", "", [d11])
'كود الترحيل بستخدام المصفوفة و دالة Resize
.Range("A" & lr).Resize(1, 7).Value = Matrix
End With
Application.ScreenUpdating = True
End Sub

في الاخير ارجو ان تكون فكرتي وصلت وان تستفيدو منها

واكرر اعتذاري للاخ الصقر الجريح وارجو ان لا اكون قد تطاولت على موضوعه

تحياتي للجميع

[الصـقر]

استاذنا الكبير

استاذى الفاضل

شوقى ربيع

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

وبخصوص ملاحظاتك على الموضوع 

1- ارجاع الوظيفة الاضافيه لتثبيت الشاشه فعلا معك كل الحق والله انا كنت هذكرها بس بعد الانتهاء من باقى الشروحات المتعلقه بالترحيل 

2-الدرس هو تبسيط المعلومه وتوصيلها للمبتدئين فكنت اختار ايسر الطرق واسهلها واقوم بشرح كل نقطة وكل سطر حتى يسهل على الاخوة الجدد التعلم ومن ثم يكون انطلاقتهم بالمنتدى ومعرفه اكثر من طريقه لنفس الموضوع 

واخير انا منتظر من حضرتك مشاركات من حضرتك اكتر انا عايز استفيد منك واستفيض من علمك

تقبل منى وافر الاحترام والتقدير

[الصـقر]

الاخوة الكرام قبل البدء فى شرح كيفية عمل سريل تلقائى لسند قبض او صرف او فاتورة 

يرجى متابعه الرابط التالى أولا

http://www.officena.net/ib/index.php?showtopic=58127#entry370299

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

[ابو تراب]

مشاء الله تبارك الله ..موضوع مميز فعلا

 

جزاك الله خيرا عن كل حرف كتبت

[الصـقر]

استاذى الفاضل

ابوتراب

مرورك على الموضوع وثناؤك علية  شرف لى وحافز لتكملة المشوار

جزيت خيرا على دعواك 

ولا تحرمنا من اضافاتك

تقبل تحياتى

[سيف الدين حسام]

الاخ الصقر الجريج

عمــــــــلاق البرمجة يا أيــها الصقر* * * أنت المعــلم والأســتــــــــاذ والأمــل

يا صــــانع المــجد يا روحًــــا مطــهَّرةً * * * لكَ التحيـــات والإكبـــار والقُبَل

تم تعديل يناير 8, 2015 بواسطه سيف الدين حسام

[الصـقر]

أخى الكريم واستاذى الحبيب

سيف الدين حسام

يا غالى سلمت على كلماتك الرائعه وانا لا استحق كل هذا فأنا والله مثلك مبتدء وبتعلم بس كل الفكرة انى عايز اوصل للناس اللى انا عارفه زى ما عرفته اوصله

تقبل تحياتى وتقديرى لشخصك الكريم

[الصـقر]

الاخوة الكرام بالمنتدى 

 اليوم أن شاء الله سنكمل شرح دروس الترحيل

 

    كيفية عمل سريل تلقائى لسند 

لعمل سريل تلقائى يتم فى خطوتين

 

الخطوة الاولى :

 

هى ادراج المعادله التاليه فى الخلية C1  كما هو موضح بالصورة المرفقه

=MAX(حركة الخزينة!B5:B100000)+1

المعادله دى هى معادله Max  ايجاد اكبر قيمة فى العمود B  بشيت حركة الخزينة   

1 +( النطاق   ثم   !  كتابة اسم ورقة العمل المراد ايجاد اكبر قيمة فى العمود بداخلها ) max =

سنلاحظ بعد كتابة اسم الورقه متبوعه ب علامه التعجب !  

لمعرفة المزيد عن داله Max يرجى مراجعه الرابط التالى 

http://www.officena.net/ib/index.php?showtopic=58127#entry370483

أذا كان الاوفيس 2010  او 2013م سنستخدم هذا المعادله

=MAX('حركة الخزينة'!B5:B100000)+1

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

 

بصراحه ايه فرق صيغه المعادله من 2007 الى 2010 او 2013  صراحه مش عارف لو فى احد من الخبراء يفسرو لنا هذا نكون شاكرين 

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

 

 

النتيجة كما هى بالصورة عاليه 1 ( وبالطبع هى نتيجة صحيحة لان شيت حركة الخزينة العمود B لم يسجل اى سند لذالك النتيجة 1)

 

الخطوة الثانية :

 

جعل الخلية G7 =C1 كما هو مبين بالكود التالى

 

نقوم بادراج مودويل جديد ولصق هذا الكود فيه

Sub جديد()
[G7] = [c1]
[d8] = ""
[d10] = ""
[d11] = ""

End Sub

ثم  الرجوع الى زر ايصال جديد الموجود بالسند وتعيين الماكرو علية كليك يمين على الزر ستظهر قائمة اختار منها تعيين الماكرو سيظهر لك شاشة اختار منها جديد  وقم بالضغط على الزر وشوف النتيجة ستجد 1 

لو سجلت سند ثم قمت بعملية الترحيل  وضغط زر جديد ستجد رقم الايصال اصبح 2   وتم مسح البيانات بخانه التاريخ وخانه المستلم والمبلغ

ولجعل شغلك اكثر احترافيه غير لون خلفيه الخلية C1  ولون الخط بها على نفس اللون حتى لا يظهر ما بداخل الخلية 

مرفق ملف للتجربة العملية 

*********

ملحوظه انا بستخدم بالشرح اسهل الطرق وايسرها 

 

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

تقبلوا منى وافر الاحترام والتقدير

خزينة.zip

[KHMB]

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

الصقر الحمد الله علي شفاءك من الجرح.

امثله قمة البساطة وشرح اجمل جزاك الله خير

تم تعديل يناير 8, 2015 بواسطه KHMB

[جلال الجمال_ابو أدهم]

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

) و كذلك اذن الصرف كأن يشمل على كذا دفعه

[الصـقر]

اخى  الفاضل / جلال الجمال - ابوادهم

أشكرك على مرورك العطر 

بخصوص طلب حضرتك ارجوا منك ارفاق ملف موضوح به ما تريد فى موضوع جديد وان شاء الله نشرح كيفية عمل ما تريد خطوة خطوة 

تقبل منى وافر الاحترام والتقدير

[سيف الدين حسام]

السلام عليكم أخى الصقر 

السلام على كل الاخوة الكرام متابعى الموضوع والاخوة الكرام بالمنتدى

السلام على كل من اتبع الهدى

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

 

كيف نرحل بشروط  - مثلا كيف نرحل اذا كان المبلغ نقدا أو شيكات

كيف تتم هذه الخطوة فى شيت الخزينة محل الدراسة

جزيتم خيرا

[الصـقر]

أخى الكريم

سيف الدين حسام

اولا يجب عمل قائمة منسدله فى الخلية G6  للاختيار منها اذا كان السند نقدى او شيك  انظر الملف المرفق علشان نبدء نشتغل على كيفية الترحيل الى نقذا والترحيل لو شيك

تقبل تحياتى

خزينة.zip

[سيف الدين حسام]

أخى الكريم

سيف الدين حسام

اولا يجب عمل قائمة منسدله فى الخلية G6  للاختيار منها اذا كان السند نقدى او شيك  انظر الملف المرفق علشان نبدء نشتغل على كيفية الترحيل الى نقذا والترحيل لو شيك

 

بارك الله فيك اخى الصقر

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

[الصـقر]

الاخوة الكرام اليوم ان شاء الله سنكمل كيفية عمل الترحيل بشروط

 

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

Sub ترحيل()
Application.ScreenUpdating = False
If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub

With Sheet4
  Lr = .Cells(.Rows.Count, "D").End(xlUp).Row

.Cells(Lr + 1, "A") = [d8]
.Cells(Lr + 1, "B") = [G7]
.Cells(Lr + 1, "D") = [d10]
.Cells(Lr + 1, "G") = [d11]
.Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]"


End With
End Sub

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

If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub

طيب انا عايز اعمل شرط لو نوع السند بالخليه G6  نقدى ينفذ الكود ولو مش نقدى مش ينفذ 

كل اللى هنعمله هنستخدم if  

If [G6] = "نقدى" Then

السطر قاعدة if  ده هيكون مكانه فين فى الكود أعلاه

 

هيكون بعد هذا السطر

 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row

وطبعا طالما فتحنا if  أذن لابد من قفلها ب end if قبل هذا السطر من الكود

End With

وهيصبح الكود بشكل النهائى كالتالى

Sub ترحيل()
Application.ScreenUpdating = False
If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub

With Sheet4
  Lr = .Cells(.Rows.Count, "D").End(xlUp).Row
If [G6] = "نقدى" Then
.Cells(Lr + 1, "A") = [d8]
.Cells(Lr + 1, "B") = [G7]
.Cells(Lr + 1, "D") = [d10]
.Cells(Lr + 1, "G") = [d11]
.Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]"

End If
End With
End Sub

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

والشرط الثانى وهو اذا كان السند نقدى يتم الترحيل غير كدا لا ميرحلش 

طيب عايز اعمل شرط ثالث لو كان G6  شيك

هيكون بهذا الشكل

If [G6] = "شيك" Then
.Cells(Lr + 1, "A") = [d8]
.Cells(Lr + 1, "B") = [G7]
.Cells(Lr + 1, "D") = [d10]
.Cells(Lr + 1, "i") = [d11]
.Cells(Lr + 1, "j") = "=R[-1]C+RC[-1]-RC[-2]"
End If

هنا عملنا قاعدة if  جديده لو كانت الخلية G6 شيك نفذ التالى 

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

Sub ترحيل()
Application.ScreenUpdating = False
If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub

With Sheet4
  Lr = .Cells(.Rows.Count, "D").End(xlUp).Row
If [G6] = "نقدى" Then
.Cells(Lr + 1, "A") = [d8]
.Cells(Lr + 1, "B") = [G7]
.Cells(Lr + 1, "D") = [d10]
.Cells(Lr + 1, "G") = [d11]
.Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[
End If

If [G6] = "شيك" Then
.Cells(Lr + 1, "A") = [d8]
.Cells(Lr + 1, "B") = [G7]
.Cells(Lr + 1, "D") = [d10]
.Cells(Lr + 1, "i") = [d11]
.Cells(Lr + 1, "j") = "=R[-1]C+RC[-1]-RC[-2]"
End If

End With
End Sub

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

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

يوجد ملف مرفق للتجربه

 

وفى النهاية تقبلوا منى وافر الاحترام والتقدير

خزينة.zip

[سيف الدين حسام]

الترحيل الى أكثر من شيت فى نفس الوقت

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

تقبل تحياتى وتقديرى لك اخى الصقر

خزينة11-1-2015.rar

تم تعديل يناير 11, 2015 بواسطه سيف الدين حسام

[الصـقر]

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

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

 انت شفت ازاى عملنا if  مرتين لو شيك او نقدا 

هيكون نفس الشئ بس مع with 

هنعمل with  تانى بس مع شيت العملاء  with Sheet3   وفى النهاية طبعا  end with  يالا شغل الجمجمه ورينى الهمه 

تقبل تحياتى