كود ترحيل وتعديل

**محمد الريفى** · يوليو 7, 2014

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

ارجو من الاخوه الافاضل

اكمال هذا العمل ومساعدتى فيه

المطلوب :

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

- عمل كود ترحيل الى صفحة اليومية العامه

-عمل كود تعديل فى حالة حاجتى لتعديل بيانات وذلك برقم مستند التوريد

-عمل كود بحث فى حالة حاجتى لتعديل بيانات وذلك برقم مستند التوريد

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

العملاء.rar

يوليو 7, 2014

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

الاخ الفاضل المحترم // الريفى

1 ) اسعدني ثقتك بي فجزاك الله خيرا

2 ) أحي الكريم لاحظ التالي

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

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

والدليل على صدق كلامي اقرا هذه المشاركة وستعلم

http://www.officena....495#entry344157

وان اردت ادلة اخري فلك ذلك فمنذ اقل من شهر الاستاذ الكبير// عبد الله باقشير قيمني ب 5 من 10 لكود نفذته ( ابتسامة )

3 ) والله اتمنى لك التوفيق والسداد وسامحنى اخي الكريم

فهذا خارج عن قدرتي....

**محمد الريفى** · يوليو 7, 2014

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

يوليو 7, 2014

وجزاك الله كل خير...ووفقنا الله واياك لطاعته

للعلم

1 ) مشاركتي _ رقم 2 _ كانت ردا على الرسالة التى ارسلتها ...ووضعتها هنا عن طريق الخطا

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

فالاعتراف بعدم العلم عندي ليس عيباً ....ولكن العيب كل العيب في العجز

نسال الله ان ينجينا واياك منه..

**محمد الريفى** · يوليو 7, 2014

اكرمك واعزك الله اخى محمد ابوالبراء

**محمد الريفى** · يوليو 7, 2014

up

**محمود_الشريف** · يوليو 8, 2014

أخى فى الله

الأستاذ / الريفى

جرب الملف المرفق

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

لاحظ أن الاستعلام يتم عن طريق كود العميل .. لأنكم لم تذكر ما هو شرط الاستدعاء

وقمت بحذف احد الشيتين نظرا لعدم الحاجة الى الشيت الخاص بالإدخال

هذا من وجهة نظرى

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

الاستاذ الريفى العملاء2.rar

يوليو 8, 2014

أخي الحبيب // محمود الشريف

تسلم ايدك على هذا العمل الرائع

جعله الله في ميزان حسناتك

وتقبل الله منا ومنك..

**محمود_الشريف** · يوليو 8, 2014

أخى فى الله

الأستاذ الحبيب // محمد ابو البراء

بارك الله فيكم على مروركم الكريم

وزادكم الله من فضله ومن علمه

نسأل رب العالمين أن يتقبل منكم صالح الأعمال

وكل عام وأنتم والأسرة الكريمه والأمه الاسلامية بخير

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

هاني سامي · يوليو 8, 2014

اخي الكريم الاستاذ محمود الشريف

الرجاء تعديل الملف حيث لا يتم الترحيل الي الشيت حيث تكرار الكود اللي موجود في العمود F

جعله الله في ميزان حسناتك

**محمد الريفى** · يوليو 8, 2014

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

الاخ الحبيب محمود الشريف

جزاكم الله خيرا على مساعدتكم لى

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

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

محمد الريفى العملاء.rar

**إبراهيم ابوليله** · يوليو 8, 2014

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

الاخ الحبيب محمود الشريف

جزاكم الله خيرا على مساعدتكم لى

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

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

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

اخى الريفى

--------------

وبعد اذن اخى محمود

------------------------

مبدأيا هل تقصد ان يكون الترحيل بهذا الشكل

العملاء.rar

**محمد الريفى** · يوليو 8, 2014

الاخ الحبيب ابراهيم ابو ليله

هذا بالظبط ما اقصده مع ملاحظة

1- عدم تكرار الترحيل

2- واحتاج وضع الاكواد فى هذا الملف نظرا لوجود معادلات فيه وهو فعلا ما ساعمل عليه

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

محمد الريفى العملاء.rar 75.44كيلو 1

**إبراهيم ابوليله** · يوليو 8, 2014

الاخ الحبيب ابراهيم ابو ليله

هذا بالظبط ما اقصده مع ملاحظة

1- عدم تكرار الترحيل

2- واحتاج وضع الاكواد فى هذا الملف نظرا لوجود معادلات فيه وهو فعلا ما ساعمل عليه

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

محمد الريفى العملاء.rar 75.44كيلو 1

اخى الريفى

ماذا تقصد بعدم تكرار الترحيل

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

**محمد الريفى** · يوليو 8, 2014

الذى اقصدة الا يكون بدون تكرار هو مستند التوريد

وقد رايت مشاركة لك وهى فاتورة بالاكسيل ولكنى لم انجح بتطبيق الكود حاولت اكثر من مره

1.bmp

**إبراهيم ابوليله** · يوليو 8, 2014

اخى الريفى

ان شاء الله يتم عمل المطلوب

تقبل تحياتى

**إبراهيم ابوليله** · يوليو 8, 2014

اخى الريفى

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

تم اضافة كود عدم التكرار

جرب واخبرنى

تقبل تحياتى

العملاء.rar

**محمد الريفى** · يوليو 8, 2014

اعزك الله واكرمك اخى الحبيب الاستاذ ابراهيم ابو ليليه هذا بالظبط هو المطلوب

واريد منك جزاك الله خير اكمال المطلوب الثانى

عمل كود تعديل فى حالة حاجتى لتعديل بيانات وذلك برقم مستند التوريد

**إبراهيم ابوليله** · يوليو 8, 2014

اعزك الله واكرمك اخى الحبيب الاستاذ ابراهيم ابو ليليه هذا بالظبط هو المطلوب

واريد منك جزاك الله خير اكمال المطلوب الثانى

عمل كود تعديل فى حالة حاجتى لتعديل بيانات وذلك برقم مستند التوريد

اخى الريفى

ان شاء الله يتم عمل المطلوب

تقبل تحياتى

**محمود_الشريف** · يوليو 8, 2014

أخى فى الله

الأستاذ الكبير // ابراهيم ابو ليله

انه لشرف لى أن تشارك فى موضوع شاركت فيه

وبارك الله فيكم وزادكم الله من فضله

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

**إبراهيم ابوليله** · يوليو 9, 2014

اخى محمود

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

كل عام وانت بخير

---------------------------

الانسان الجميل ذو الكلمات الرقيقه

والاسلوب المهذب هو من يتشرف به الاخرين

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

بارك الله فيك

**محمد الريفى** · يوليو 9, 2014

الاساتذه الكرام

الاستاذ ابراهيم ابوليه

الاستاذ محمود الشريف

جزاكم الله خيرا على مساعداتكم

فقد تم تنفيذ المطلوب الاول بنجاح

ويتبقى المطلوب الثانى

عمل كود تعديل فى حالة حاجتى لتعديل بيانات وذلك برقم مستند التوريد

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

**محمد الريفى** · يوليو 9, 2014

الاخ الكريم الاستاذ ابراهيم

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

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

العملاء_3.rar

**إبراهيم ابوليله** · يوليو 9, 2014

اخى الريفى

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

--------------------------------

الخطأ كان فى تسلسل الكود الاتى

If WS.Cells(9, 2).Value <> "" Then
---------------------------------------
If WS.Cells(9
رقم 9 يشير الى السطر التاسع فى الفاتوره
لذلك يجب عمل تسلس حتى نصل الى اخر سطر فى الادخال وهو السطر رقم 31
اى حتى يصبح الكود على الشكل الاتى
If WS.Cells(31

استبدل الكود بالكود الاتى

Sub hima_trs1()
Application.ScreenUpdating = False
Dim LR As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("ÇáÑÆíÓíå")
Set WS1 = Worksheets("ÇáíæãíÉ ÇáÚÇãå")
LR = WS.Range("B100").End(xlUp).Row + 1
LR1 = WS1.Range("F10000").End(xlUp).Row + 1
LR2 = WS1.Range("B10000").End(xlUp).Row + 1
    For r = 5 To LR1
       If WS1.Cells(r, 4) = WS.Range("D5") Then MsgBox "Êã ÊÓÌíá ãÓÊäÏ ÇáÊæÑíÏ ÓÇÈÞÇ": Exit Sub
   Next

WS.Range("B9:Z" & LR).Copy
WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues

If WS.Cells(9, 2).Value <> "" Then
WS1.Cells(LR2, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2, 5).Value = WS.Cells(6, 4).Value

End If
If WS.Cells(10, 2).Value <> "" Then
WS1.Cells(LR2 + 1, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 1, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 1, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 1, 5).Value = WS.Cells(6, 4).Value

End If
If WS.Cells(11, 2).Value <> "" Then
WS1.Cells(LR2 + 2, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 2, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 2, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 2, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(12, 2).Value <> "" Then
WS1.Cells(LR2 + 3, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 3, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 3, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 3, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(13, 2).Value <> "" Then
WS1.Cells(LR2 + 4, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 4, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 4, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 4, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(14, 2).Value <> "" Then
WS1.Cells(LR2 + 5, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 5, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 5, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 5, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(15, 2).Value <> "" Then
WS1.Cells(LR2 + 6, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 6, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 6, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 6, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(16, 2).Value <> "" Then
WS1.Cells(LR2 + 7, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 7, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 7, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 7, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(17, 2).Value <> "" Then
WS1.Cells(LR2 + 8, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 8, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 8, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 8, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(18, 2).Value <> "" Then
WS1.Cells(LR2 + 9, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 9, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 9, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 9, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(19, 2).Value <> "" Then
WS1.Cells(LR2 + 10, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 10, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 10, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 10, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(20, 2).Value <> "" Then
WS1.Cells(LR2 + 11, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 11, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 11, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 11, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(21, 2).Value <> "" Then
WS1.Cells(LR2 + 12, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 12, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 12, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 12, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(22, 2).Value <> "" Then
WS1.Cells(LR2 + 13, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 13, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 13, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 13, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(23, 2).Value <> "" Then
WS1.Cells(LR2 + 14, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 14, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 14, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 14, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(24, 2).Value <> "" Then
WS1.Cells(LR2 + 15, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 15, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 15, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 15, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(25, 2).Value <> "" Then
WS1.Cells(LR2 + 16, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 16, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 16, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 16, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(26, 2).Value <> "" Then
WS1.Cells(LR2 + 17, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 17, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 17, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 17, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(27, 2).Value <> "" Then
WS1.Cells(LR2 + 18, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 18, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 18, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 18, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(28, 2).Value <> "" Then
WS1.Cells(LR2 + 19, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 19, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 19, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 19, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(29, 2).Value <> "" Then
WS1.Cells(LR2 + 20, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 20, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 20, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 20, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(30, 2).Value <> "" Then
WS1.Cells(LR2 + 21, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 21, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 21, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 21, 5).Value = WS.Cells(6, 4).Value
End If
If WS.Cells(31, 2).Value <> "" Then
WS1.Cells(LR2 + 22, 2).Value = WS.Cells(3, 4).Value
WS1.Cells(LR2 + 22, 3).Value = WS.Cells(4, 4).Value
WS1.Cells(LR2 + 22, 4).Value = WS.Cells(5, 4).Value
WS1.Cells(LR2 + 22, 5).Value = WS.Cells(6, 4).Value
End If
 Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

تقبل تحياتى

**محمد الريفى** · يوليو 9, 2014

الاخ الحبيب ابراهيم ابوليله

ارجو ان

تسامحنى فى اسالتى الكثيره

تسجيل الدخول

كود ترحيل وتعديل

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

محمد الريفى

زائر

محمد الريفى

زائر

محمد الريفى

محمد الريفى

محمود_الشريف

زائر

محمود_الشريف

هاني سامي

محمد الريفى

إبراهيم ابوليله

محمد الريفى

إبراهيم ابوليله

محمد الريفى

إبراهيم ابوليله

إبراهيم ابوليله

محمد الريفى

إبراهيم ابوليله

محمود_الشريف

إبراهيم ابوليله

محمد الريفى

محمد الريفى

إبراهيم ابوليله

محمد الريفى

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information