ياسر العربى

هذه مجرد رسالة تنبيه لعدم وجود الصورة قمت بازالتها حتى لا تعيقك اثناء الكتابة تفضل المرفق ضع ملف الاكسيل مكان الموجود عندك Yasser.rar

قم بكتابتها مكان الID الموجود عادي وستظهر لك بياناته! اذا واجهتك مشكلة الرسالة احذفها من الكود احذف هذه الرسالة MsgBox "الصورةغير موجودةبالمسار"

تفضل هذا المثال قد كنت انهيته قبل ان تضع مشاركتك هذه باذن الله نكمل طلبك تقبل تحياتي CARDS.rar

تفضل هذا المثال لعله ينفعك CARDS.rar

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

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

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

تفضل كود بحث واستبدال لعله يفي بالغرض تغير التاريخ.rar

راجع الصورة جيدا وانظر اين تم وضع الكود اما المرفق فقد وضعت الكود داخل الحدث SelectionChange فكل ما تضغط في مكان تطلع الرسالة دي تم وضع الكود في مكانه الصحيح تفضل طباعة.rar

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

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

تفضل هل هذا ما تقصده؟ test2.rar

تفضل لعله المطلوب sumif.rar

ادخل هنا ان وجدت اي ارتباطات قم بازالتها ان لم تجد ادخل هنا ان وجدت اسماء وبها اخطاء او ارتباطات قم بحذفها

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

الكود موجود في حدث قبل الطباعة داخل الـ Workbook جرب اطبع عادي وانت تعرف ودي صورة توضح موضع الكودين

اخي الكريم الملف تقيل من كثرة الشيتات والبيانات والمعادلات والتنسيقات والكائنات عند ادارج حتى صف واحد يأخذ وقت طويل جدا المهم عملت لك كود اخر نتحايل على الموضوع دا تفضل بدل الكود بهذا الكود Sub Yasserelaraby() Dim last As Long, y As Long, x As Long, b As Long Dim bb As Long, zz As Long, vv As Long Application.ScreenUpdating = False last = ActiveSheet.Range("b6").End(xlDown).Row Range("b6:bx" & last).Copy: Range("b1000").PasteSpecial Range("b6:bx" & last).ClearContents zz = Application.WorksheetFunction.CountA(Range("b1000:b1800")) y = 29 b = 1000 bb = 6 Do vv = Application.WorksheetFunction.CountA(Range("v6:v900")) If vv >= zz Then GoTo 0 Range("b" & b & ":bx" & b + y).Copy: Range("b" & bb & ":bx" & bb).PasteSpecial Application.CutCopyMode = False last = ActiveSheet.Range("b6").End(xlDown).Row Sheets("كعب الشيت").Rows("2:7").Copy ActiveSheet.Rows(last + 1).PasteSpecial Application.CutCopyMode = False b = b + 30 bb = bb + 36 Loop 0 last = ActiveSheet.Range("b1000").End(xlDown).Row Range("b1000:bx" & last).Clear Application.ScreenUpdating = True MsgBox "تم بحمد الله ادراج كعب الشيت بجميع الصفحات " End Sub جرب وبلغني تقبل تحياتي رقم 36 مجموع عدد الطلاب ال30 بالاضافة الى 6 عدد صفوف كعب الشيت لكل صفحة تحياتي

تفضل اخي الكريم ضع اي بيانات وهميه وجرب Book2.rar

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

بالفعل اخي الكريم هو يذهب الى اخر صف به بيانات لا يغرك الرقم10000 هو بمثابة انك واقف على الخلية a10000 وقمت بالضغط على زر end ثم سهم الى اعلى ستجد ان التحديد ذهب الى اخر صف به بيانات والبطئ ليس من الكود البطئ من معادلات المصنف نفسه وقمت بوضع خطوة لتخفيف الكود ولو مش عجبك دي اكتب دي last = Sheets("ناجح").Cells(Rows.Count, "a").End(xlUp).Row وشكرا

شرح الكود Sub RoundedRectangle3_Click() ' الاعلان عن متغير من نوع لونج يشير الى اخر صف به بيانات Dim last As Long 'الاعلان عن متغير من نوع لونج يشير الى كل خطوة لوضع التذييل لكل 30 طالب لكل صفحة Dim y As Long '' اول صف سيوضع فيه التذييل y = 40 'لايقاف الحساب التلقائي لعلاج موضوع بطئ عمل الكود اذا كان البطئ من كثرة معادلات المصنف Application.Calculation = xlManual 'حلقة تكرارية تبدأ ب (دو)وتنتهي ب (لووب)وهي لتكرار التذييل حتى ان نصل لاخر صفحه بها بيانات Do 'لمنع اهتزاز الشاشه Application.ScreenUpdating = False 'تعريف المتغير الخاص باخر صف به بيانات last = Sheets("ناجح").Range("a10000").End(xlUp).Row 'هنا نضع شرط اذا كان المتغير واي اكبر من او يساوي اخر صف به بيانات فيخرج الى خارج الحلقة التكرارية الى السطر الموجود به الصفر 'وقمنا بانقاص -36 لانه قمنا باضافتها بالاسفل ولكي نقارن بين المتغير واي واخر صف يجب طرح 36 من الواي او اضافتهم الى لاست If y - 36 >= last Then GoTo 0 ' نسخ الكعب المراد وضعه في صفحة الطلاب Sheets("كعب الشيت").Rows("2:7").Copy ' وضع الكعب بعد كل 30 طالب وازاحة الباقين للاسفل حتى ينتهي من كل البيانات Sheets("ناجح").Rows(y).Insert Shift:=xlDown 'لايقاف خاصيه القص والنسخ Application.CutCopyMode = False ' هنا نقوم باضافة 36 للمتغير وهي قيمة ال30 طاللب بالاضافة لهم الكعب 6 y = y + 36 ' هنا لوووووب بتقولنا نروح للــ دوووو عشان نعيد الكود تاني حتى يتحقق الشرط السابق من الكود Loop 'هنا بعد تحقق الشرط نجد ان حركة الكود تخرج الى الرقم صفر ' ' لاعاده تحديث الشاشه 0 Application.ScreenUpdating = True 'اعادة الحساب التلقائي Application.Calculation = xlAutomatic 'رسالة تفيد انتهاءالعملية MsgBox "تم بحمد لله" End Sub

شرح الكود Sub RoundedRectangle3_Click() ' الاعلان عن متغير من نوع لونج يشير الى اخر صف به بيانات Dim last As Long 'الاعلان عن متغير من نوع لونج يشير الى كل خطوة لوضع التذييل لكل 30 طالب لكل صفحة Dim y As Long '' اول صف سيوضع فيه التذييل y = 40 'لايقاف الحساب التلقائي لعلاج موضوع بطئ عمل الكود اذا كان البطئ من كثرة معادلات المصنف Application.Calculation = xlManual 'حلقة تكرارية تبدأ ب (دو)وتنتهي ب (لووب)وهي لتكرار التذييل حتى ان نصل لاخر صفحه بها بيانات Do 'لمنع اهتزاز الشاشه Application.ScreenUpdating = False 'تعريف المتغير الخاص باخر صف به بيانات last = Sheets("ناجح").Range("a10000").End(xlUp).Row 'هنا نضع شرط اذا كان المتغير واي اكبر من او يساوي اخر صف به بيانات فيخرج الى خارج الحلقة التكرارية الى السطر الموجود به الصفر 'وقمنا بانقاص -36 لانه قمنا باضافتها بالاسفل ولكي نقارن بين المتغير واي واخر صف يجب طرح 36 من الواي او اضافتهم الى لاست If y - 36 >= last Then GoTo 0 ' نسخ الكعب المراد وضعه في صفحة الطلاب Sheets("كعب الشيت").Rows("2:7").Copy ' وضع الكعب بعد كل 30 طالب وازاحة الباقين للاسفل حتى ينتهي من كل البيانات Sheets("ناجح").Rows(y).Insert Shift:=xlDown 'لايقاف خاصيه القص والنسخ Application.CutCopyMode = False ' هنا نقوم باضافة 36 للمتغير وهي قيمة ال30 طاللب بالاضافة لهم الكعب 6 y = y + 36 ' هنا لوووووب بتقولنا نروح للــ دوووو عشان نعيد الكود تاني حتى يتحقق الشرط السابق من الكود Loop 'هنا بعد تحقق الشرط نجد ان حركة الكود تخرج الى الرقم صفر ' ' لاعاده تحديث الشاشه 0 Application.ScreenUpdating = True 'اعادة الحساب التلقائي Application.Calculation = xlAutomatic 'رسالة تفيد انتهاءالعملية MsgBox "تم بحمد لله" End Sub الاخت الكريمة هذا كود لوضع تذييل لكل صفحة بدلا من التذييل المحدود بالبرنامج اذا صعب تطبيقه ارفقى ملف يوضح البيانات وارفقى شكل التذييل المراد تحت احد الصفحات بالشيت الموضوع ليس مكرر اخي الكريم فقط الطلب متشابه بهذ الموضوع تقبلو تحياتي

تفضل sumif.rar

تفضل لازالة هذه الرسالة وتفعيل الماكرو ايضا http://www.officena.net/ib/topic/64472-بداية-الطريق-لإنقاذ-الغريق/ تفضل فيديو يشرح الطريقة yasser.rar