طلب تعديل كود استدعاء وترحيل بيانات

[ناصرالمصرى]

السلام عليكم وحياكم الله اخوانى الافاضل

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

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

من جود كرمكم وعلمكم  

بالمرفق التالى استدعاء بيانات بمعلومية الرقم الوظيفى

ومن ثم ترحيل هذة البيانات ونقلها كل عشرة ثوانى

الطلب موضح بالمرفق التالى " استدعاء وترحيل ونقل بيانات كل عشر ثوانى"

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

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

 

استدعاء بيانات.xlsb.rar

استدعاء وترحيل ونقل بيانات كل عشر ثوانى.xlsb.rar

[ناصرالمصرى]

للرفع

[ناصرالمصرى]

للرفع

[ناصرالمصرى]

للرفع رفع الله قدركم

[ناصرالمصرى]

أخوانى الافاضل

نرجو الاهتمام بطلبى هذا 

المشكلة هنا فى عدم تنسيق الملف

فهل يوجد كود يوضع بـــ ThisWorkbook

من شأنه تنسيق كافة أوراق المصنف أو تعديل كود

الاستدعاء إو إضافة أوامر أخرى على نحو يتم توحيد تنسيق الملف

من نوع الخط وحجمه وعرض الاعمدة وارتفاع الصفوف

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

استدعاء وترحيل ونقل بيانات كل عشر ثوانى + 2.xlsb.rar

تم تعديل نوفمبر 10, 2015 بواسطه ناصر المصرى

[ياسر العربى]

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

علي العموم اتمنى ان يتفاعلوا مع موضوعك  وارجوا التماس العذر لهم لعلهم مشغولين 

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

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

ان شاء الله نجد حل

[ياسر العربى]

شوف كدا موضوع التنسيق دا اللي تقصدة

 املا بيانات شيت  بس من اول العمود A 

وبعدين اخرج من الشيت وارجع ليه وشوف يامعلم

وصغر الخط وارجع وافتحه تاني واتفرج يامعلم

وصغر الصف والعمود شوية وارجع وشوف يامعلم

واعمل شيتات جديدة وحط بيانات وروح شيت تاني وارجع وشوف

وياريت دا اللي تقصده

 

yasser.rar

[ناصرالمصرى]

السلام عليكم

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

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

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

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

التنسيق المطلوب واعتقد انه ليس من المحال تنفيذة

اولا الورقة 3

المطلوب استدعاء البيانات بنفس تنسيق الورقه 2 من العمود A  الى العمود  J

ثانيا الورقة 4

المطلوب ترحيل البيانات بنفس تنسيق الورقة 3 من العمود E  الى العمود  V

ثالثا الورقة  SALARY  

المطلوب نقل البيانات بنفس تنسيق الورقة 4 من العمود A   الى العمود  V

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

بالكود ويبقى العمل على نوع الخط =  Times New Roman

وحجم الخط وارتفاع الصف 

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

[احمدزمان]

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

اسعد الله صباحكم بكل خير

بعد الشكر الجزيل لأخونا ياسر

 

الكود التالي يقوم بنسخ التنسيقات من ورقة 2 من A  الى  J

وينسخها الى كافة اوراق الملف

Sub MACRO1()
'äÓÎ ÊäÓíÞ æÑÞÉ 2 Çáì ßá ÇæÑÇÞ ÇáãáÝ
Dim RN1 As Range, SH, ER
'
Sheets("ورقة2").Select
    Sheets("ورقة2").Range("A9:J9").Copy
For SH = 2 To Sheets.Count
ER = Sheets(SH).UsedRange.Rows.Count
Set RN1 = Sheets(SH).Range("A8:J" & ER)
    RN1.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    RN1.PasteSpecial Paste:=xlPasteColumnWidths
Next SH
    Application.CutCopyMode = False
End Sub

 

[ناصرالمصرى]

الاستاذ القدير / احمد 

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

بارك الله فى حضرتك 

كود اكثر من رائع

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

وافر تقديرى واحترامى

[ناصرالمصرى]

الاستاذ القدير / احمد زمان

حياكم الله وأسعد الله اوقاتك بكل خير

عذرا أخى لعدم الرد فى حينة 

وشاكر لك أخى الفاضل سعة صدرك

اولا الكود الذى تفضلت به يعمل بشكل ممتاز ولكن

أضطر هنا لتغعيله كل مرة من داخل محرر الاكواد

فضلا عن ظهور رسالة خطأ بهذا السطر 

    Set A = Sheets("sheet4").Columns("E").SpecialCells(2, 1).Areas

فكيف يمكن تفعيله مع  بداية الضغط على Ctrl + q  ليعمل بشكل تلقائى 

أخى الكريم المرفق التالى يوضح ما أقصده 

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

 

استدعاء بيانات.xlsb.rar

[ابوخليل]

السلام عليكم

الاخ ناصر طلب مني المساعدة ولم يعلم ان خبرتي في اكسل افرغ من فؤاد ام موسى

  ولكني قد افيده في كيفية تفعيل اي كود وقت الحاجة

     اولا نحول الكود الى وحدة نمطية عامة

    يعني سيصبح كود استاذنا احمد هكذا :

Public Function macrox()
'äÓÎ ÊäÓíÞ æÑÞÉ 2 Çáì ßá ÇæÑÇÞ ÇáãáÝ
Dim RN1 As Range, SH, ER
Sheets("æÑÞÉ2").Select
    Sheets("æÑÞÉ2").Range("A9:J9").Copy
For SH = 2 To Sheets.Count
ER = Sheets(SH).UsedRange.Rows.Count
Set RN1 = Sheets(SH).Range("A8:J" & ER)
    RN1.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    RN1.PasteSpecial Paste:=xlPasteColumnWidths
Next SH
    Application.CutCopyMode = False
End Function

الآن نستطيع ان نستدعي هذا الكود وتشغيله في اي حدث فقط نكتب العبارة التالية :

Call macrox

 

[ناصرالمصرى]

وعليكم السلام استاذى الفاضل / ابو خليل

شاكر فضل حضرتك لاهتمامك بطلبى

ولكن المشكلة مازالت قائمة بظهور رسالة الخطأ

يرجى من السادة الزملاء التدخل فى ارفاق مرفق

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

تم تعديل نوفمبر 15, 2015 بواسطه ناصر المصرى

[ياسر العربى]

ابعت ياعم ناصر اخر ملف انت توصلت ليه  

واخر مشكلة به لحلها

معلش حبيبي ضيق الوقت 

وتراكم المهام مشكلة كل واحد

ارجو التماس العذر

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

 

[ناصرالمصرى]

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

بداية شاكر فضلك وبارك الله فيك

وشاكر فضل اخى الكريم احمد زمان واخى الفاضل ابو خليل

أدرك انكم مشفقون علىّ بخصوص هذا الموضوع المتوقف على أخر جزئية فى مشروع تخرجى

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

كلا الكودين يعملان بشكل ممتاز ولكن المشكلة

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

ومن ثم الرجوع للورقة 3 لكى يتم الضغط على Ctrl+q  لكى تبدأ العمل بالبرنامج

قم باستدعاء البيانات وتتبع الرسائل ومن ثم قم بحذفها

وعاود الاستدعاء مرة أخرى ولاحظ

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

ملحوظة لقد ذكر اخى الكريم ابو خليل انك تستطيع استدعاء الكود بكتابة عبارة 

Call macrox

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

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

استدعاء بيانات + 111.xlsb.rar

تم تعديل نوفمبر 15, 2015 بواسطه ناصر المصرى

[ياسر العربى]

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

 

 

استدعاء بيانات + 111.xlsb.rar

[احمدزمان]

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

 

خالص الشكر و التقدير للأستاذنا الفاضل ابو خليل

و الأخ الفاضل ياسر

 

اخي ناصر

حاولت فتح الملف ولكن تواجهني رسالة (( لم يتم التعرف على تنسيق هذا الملف ))

لذلك

اذا لم يتم حل المشكله فضلا رفع الملف بصيغة XLS او اوفيس 2003

مع التحية

 

[ناصرالمصرى]

اخى الفاضل الحاج / احمد

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

شاكر فضل حضرتك لعودة الروح 

اليك اخى الفاضل المرفقين الاول بصيغة 2003

والثانى بصيغة XLS 

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

 

استدعاء بيانات 111.rar

استدعاء بيانات + 111.XLS.rar

[ناصرالمصرى]

اخى الفاضل الاستاذ  / ياسر العربى

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

شاكر فضل حضرتك

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

وسأخبرك فى حينه

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

 

تم تعديل نوفمبر 15, 2015 بواسطه ناصر المصرى

[احمدزمان]

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

 

تم اضافة الكود الى Ctrl+Q مع رسالة تنفيذ

آمل ان يكون هذا المطلوب

استدعاء بيانات 111.rar

[ناصرالمصرى]

اخى القاضل الحاج احمد

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

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

ويمنى القديرالفاضل الحاج / أبو خليل

انتم جميعا قيمة علمية نرتوى بعلمهم وقامة عالية يحتذى بها

تم تجربة الملفات وبقيت خطوة أخيرة

ألا وهى ظهور رسالة خطأ بالموديول رقم 3 عند الانتقال الى رسالة 

" هل تريد نقل البيانات لطباعة الكشوف "على النحو التالى

    Set A = Sheets("sheet4").Columns("E").SpecialCells(2, 1).Areas

هذا وبعد إذن حضرتك يرجى فضلا بعد تضبيط تلك الجزئية ان يكون

الانتقال لورقة نقل البيانات تلقائيا بعد الضغط على خيار نعم برسالة نقل البيانات

وشاكر فضل حضرتك وجزاكم الله خيرا

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

تم تعديل نوفمبر 15, 2015 بواسطه ناصر المصرى

[احمدزمان]

و عليكم السلام

اخي جرب الملف التالي

 

بإذن الله لن تواجه هذه المشكلة

تم اضافة سطر للكود on error resum next

استدعاء بيانات 111.rar

[ناصرالمصرى]

اخى الفاضل الحاج احمد

السلام عليكم

تمام الله عليك ياحبيب والديك

ظهرت رسالة أخرى بالموديول 3 بهذا السطر بعد 10 ثوانى

  If CurIndex > UBound(Arr) Then

كما ارجو ان يكون الانتقال لورقة نقل البيانات تلقائيا بعد الضغط على خيار نعم برسالة نقل البيانات

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

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

تم تعديل نوفمبر 16, 2015 بواسطه ناصر المصرى

[ناصرالمصرى]

للرفع

[ياسر العربى]

تفضل حبيبي يارب اكون توصلت لمساعدتك 

بما تريده

ومنتظر منك الملاحظات

تم حل كل المشاكل علي حد فهمي لما تريده

استدعاء بيانات 12211.rar