الى الأخ العزيز نزار سليمان وجميع الخبراء

[obad65]

الأخوة الاعزاء مشرفي القسم

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

سؤالي وهو :

مع التحية للأخوة خبراء المنتدى الكرام

لقد قمت بعمل برنامج متواضع لادارة محافظ الاسهم ولكن أود منكم مساعدة في جدول المحافظ نفسها

صفحة 1 و 2 بحيث يتم ترحيل الاسهم الموجودة في المحفظة في صفحة حركة التداول (اسم الشركة وعدد الاسهم) فقط التي ليس لها تاريخ بيع

آمل من الجميع المشاركة في مساعدتي مع علمي بحرص الجميع على منفعة الأعضاء

ولكم وافر التقدير والاحترام

الملفات المرفقة

____________.rar ( 99.39كيلوا بايت ) عدد مرات التحميل: 34

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

أرجو المساعدة في برنامجي المتواضع, محافظ الاسهم

آمل مما لديه بعض الخبرة أن يساعدني

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

[نزار سليمان عيد]

اخي الكريم السلام عليكم

عذرا على التاخر في الرد

انظر المرفق واي استفسار اعلمني من فضلك

____________.rar

[obad65]

مع شكري وتقديري للأخ نزار

لا أستطيع فتح أي مرفق منذ يوم الأربعاء الماضي حيث تظهر رسالة

! C:\Documents and Settings\48532\Desktop\____________.rar: Unexpected end of archive

لذا آمل ارسال الملف على البريد الالكتروني إن أمكن ذلك أوكتابة الكود مباشرة

[نزار سليمان عيد]

اخي الكريم السلام عليكم

ممكن ترسل ايميلك الخاص لارسال الملف

[obad65]

مع شكري لتجاوبك آخ نزار

تم التمكن من قراءة المرفق

الا أنه لم يتم عمل المطلوب

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

وعند الضغط على الماكرو مرة أخرى يقوم بعمل تحديث

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

مع شكري لتجاوبك وآمل تواصلك لحين الوصول الى المطلوب

[نزار سليمان عيد]

اخي الكريم السلام عليكم

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

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

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

والتواصل موجود ان شاء الله للجميع

[obad65]

الاخ نزار

آسف على مابدر مني ولكنني في بداية الأمر كتبت الموضوع بطلب المساعدة من الجميع ولم يتم الرد علي سواء بالمعرفة أو الانتظار

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

تم التجاوب

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

عليه آمل الاطلاع على الملف الجديد ومحاولة مساعدتي وجزاك الله خيرا

وشكرا

____________01.rar

[نزار سليمان عيد]

اخي الكريم السلام عليكم

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

_________________.rar

[obad65]

الأخ العزيز نزار

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

جزاك الله خير الجزاء وجعله في موازيين حسناتك

ولي طلبان وآمل الرد عليها للأهمية

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

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

http://www.officena.net/ib/index.php?showtopic=23213

مع خالص شكري وتقديري لجميع المشرفين في المنتدى

[obad65]

آمل قبول اعتذاري

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

http://www.officena.net/ib/index.php?showtopic=22073

مع الشكر

[نزار سليمان عيد]

اخي الكريم السلام عليكم

بالنسبة لطلبك الاول سنعرض الكود ثم يتم الشرح

2.[A5:R30].ClearContents هنا يتم مسح بيانات الصفحة التي ستنقل لها المعلومات من سطر 5 الى سطر 30

For R = 5 To [A30].End(xlUp).Row هنا من سطر 5 الى سطر 30 يقوم بتنفيذ ما يلي

If Cells(R, 9) = "" Then اذا العمود رقم 9 لايوجد به تاريخ قم بعمل

With ورقة2.[A30].End(xlUp)

.Offset(1, 0) = ورقة3.Cells(R, 1) نقل محتوى كل عمود من 1 الى 17

.Offset(1, 1) = ورقة3.Cells(R, 2)

.Offset(1, 2) = ورقة3.Cells(R, 3)

.Offset(1, 3) = ورقة3.Cells(R, 4)

.Offset(1, 4) = ورقة3.Cells(R, 5)

.Offset(1, 5) = ورقة3.Cells(R, 6)

.Offset(1, 6) = ورقة3.Cells(R, 7)

.Offset(1, 7) = ورقة3.Cells(R, 8)

.Offset(1, 8) = ورقة3.Cells(R, 9)

.Offset(1, 9) = ورقة3.Cells(R, 10)

.Offset(1, 10) = ورقة3.Cells(R, 11)

.Offset(1, 11) = ورقة3.Cells(R, 12)

.Offset(1, 12) = ورقة3.Cells(R, 13)

.Offset(1, 13) = ورقة3.Cells(R, 14)

.Offset(1, 14) = ورقة3.Cells(R, 15)

.Offset(1, 15) = ورقة3.Cells(R, 16)

.Offset(1, 16) = ورقة3.Cells(R, 17)

.Offset(1, 17) = ورقة3.Cells(R, 18)

End With

End If نهاية الشرط

Next

MsgBox "!تم ترحيل الصفوف المطلوبة بنجاح", vbInformation, "تم الترحيل" ظهور رسالة توضيحية ان الترحيل تم

End Sub

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

[obad65]

جزاك الله خير وكثر من أمثالك