المســـاعدة في كــــود نســـخ ولصـــق

أيمن ابراهيم · يونيو 11, 2016

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

كل عام وانتم بخـــير بمناسبة شهر رمضان الكريم اعادة الله عليكم بكل خـــير

وبعد : المطلوب من السادة الاعضاء الكرام المساعدة في كتابة كود بالملف المرفق

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

لكم منى وافر التحية والاحترام

1.rar

**omar elhosseini** · يونيو 11, 2016

الاخ أيمن ابراهيم

( ألن تحتاج الي رأس للشيت ايضا ( ال 9 صفوف في اول الورقة ناجح

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

أيمن ابراهيم · يونيو 11, 2016

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

تم تعديل يونيو 11, 2016 بواسطه أيمن ابراهيم

**ياسر العربى** · يونيو 11, 2016

تفضل اخي

1213123.rar

أيمن ابراهيم · يونيو 11, 2016

13 دقائق مضت, ياسر العربى said:

تفضل اخي

1213123.rar

الشكر كل الشكر الاستاذ الفاضل ياسر العربي

هذا هو الملطوب كما اردت لك منى جزيل الشكر

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

2.rar

**ياسر العربى** · يونيو 11, 2016

تفضل اخي ايمن

2.rar

أيمن ابراهيم · يونيو 11, 2016

12 دقائق مضت, ياسر العربى said:

تفضل اخي ايمن

2.rar

اشــكرك شـــكراً جــــزيلاً اخــي الفـــاضل ياســر العـــربي

تقـبل تحيــاتي لك من وافـــر التحــية وكل عــام وانتـــم بخـــــير

**ياسر العربى** · يونيو 11, 2016

الحمد لله ان تم المطلوب

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

تقبل تحياتي

:fff:

أيمن ابراهيم · يونيو 14, 2016

في ١١‏/٦‏/٢٠١٦ at 14:26, ياسر العربى said:

الحمد لله ان تم المطلوب

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

تقبل تحياتي

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

عند وضع الكود في الشيت كنترول الرئيسي الكود يأخذ وقت طويل جداً عن تنفيذ الكود خارج الشيت كنترول الرئيسي

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

تقبل تحياتي

**ياسر العربى** · يونيو 14, 2016

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

ووقت نقل التذييل لم يتعدى ال16 ثانية لجهاز متوسط الامكانيات

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

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

هعملك طريقة وتجربها

Sub RoundedRectangle3_Click()
    Dim last As Long
    Dim y As Long
    y = 40
 Application.Calculation = xlManual
    Do
        Application.ScreenUpdating = False
        last = Sheets("ناجح").Range("a10000").End(xlUp).Row
        If y - 36 >= last Then GoTo 0
        Sheets("كعب الشيت").Rows("2:7").Copy
        Sheets("ناجح").Rows(y).Insert Shift:=xlDown
        Application.CutCopyMode = False
        y = y + 36
    Loop
0   Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    MsgBox "تم بحمد الله"
End Sub

ضع الكود دا وجرب كدا

asdhamdey · يونيو 14, 2016


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

اقتباس (

الاستاذ الكريم ياسر العربي وضغت شرح لبعض الجمل لكودك الرائع ليكون مرجعا سهلا للاخوه

ارجو ان تكمل الشرح للجمل التي لم استطع شرحها )

asdhamdey · يونيو 14, 2016

هل يمكن جعل المدى مطاط بعدد الطلاب فتزيد السرعه لانه بطيء جدا

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

**ياسر العربى** · يونيو 14, 2016

شرح الكود

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

asdhamdey · يونيو 14, 2016

مش فاهم الرقم 36 الموجود بالكود وكذلك الرقم 30

أيمن ابراهيم · يونيو 14, 2016

4 ساعات مضت, ياسر العربى said:
اخي الكريم لقد قمت بتوسيع نطاق البيانات فوق 16 الف صف

ووقت نقل التذييل لم يتعدى ال16 ثانية لجهاز متوسط الامكانيات

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

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

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

اخى الفاضل الاستاذ ياسر لك منى وافر التحية والاحترام

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

مرسل اليكم الشيت للتجربة والتصحيح والتعديل

اسم المستخدم ayman السري 2010

رابــــط خارجي للملف لعدم امكانية رفع الملف على المنتدى لكبر حجمه

http://3rbup.com/77ee97214877fd6a

asdhamdey · يونيو 14, 2016

ملفك يا استاذ ايمن به جهد ملحوظ بارك الله فيك

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

Sub printpreview1()
'كود معاينة طباعة مطاطي
Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).printpreview
End Sub

Sub print_2()
'كود طباعة مطاطي
Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).PrintOut
End Sub

asdhamdey · يونيو 14, 2016

'كود معاينة طباعة
Sub printpreview()
ActiveWindow.SelectedSheets.printpreview
End Sub

الصفحات محميه نرجو فكها او ماهو الرقم السري

أيمن ابراهيم · يونيو 14, 2016

منذ ساعه, asdhamdey said:
ملفك يا استاذ ايمن به جهد ملحوظ بارك الله فيك

وهذا كود موجود بداخله من الروائع ليستفيد منه الجميع والدعاء الطيب موصول لصاحبه
Sub printpreview1()
'كود معاينة طباعة مطاطي
Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).printpreview
End Sub
Sub print_2()
'كود طباعة مطاطي
Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).PrintOut
End Sub

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

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

بالنسبة لحماية الصفحات جميعها 2010 وهى موجودة بداخل الاكواد الموجودة بالشيت

تقبل تحياتي

asdhamdey · يونيو 15, 2016

6 ساعات مضت, asdhamdey said:

مش فاهم الرقم 36 الموجود بالكود وكذلك الرقم 30

لماذا الرقم 36 بالذات والرقم 30 بالذات

**ياسر العربى** · يونيو 15, 2016

10 ساعات مضت, أيمن ابراهيم said:

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

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

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

جرب وبلغني

تقبل تحياتي

9 ساعات مضت, asdhamdey said:

لماذا الرقم 36 بالذات والرقم 30 بالذات

رقم 36 مجموع عدد الطلاب ال30 بالاضافة الى 6 عدد صفوف كعب الشيت لكل صفحة

تحياتي

**ياسر العربى** · يونيو 15, 2016

10 ساعات مضت, أيمن ابراهيم said:

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

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

فيصبح بدون الوان

اتمنى ان يكون تم المطلوب

تقبل تحياتي

ايمن النهائي.rar

أيمن ابراهيم · يونيو 15, 2016

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

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

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

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

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

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

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

تم تعديل يونيو 15, 2016 بواسطه أيمن ابراهيم

**ياسر العربى** · يونيو 15, 2016

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

وكل عام وانتم بكل صحة وعافية

ايمن النهائي.rar

أيمن ابراهيم · يونيو 16, 2016

7 ساعات مضت, ياسر العربى said:

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

وكل عام وانتم بكل صحة وعافية

ايمن النهائي.rar

اشكرك شكراً جزيلاً استاذي ياسر

هذا هو المطلوب بالضبط

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

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

asdhamdey · يونيو 16, 2016

في ١٥‏/٦‏/٢٠١٦ at 02:25, أيمن ابراهيم said:

بالنسبة لحماية الصفحات جميعها 2010 وهى موجودة بداخل الاكواد الموجودة بالشيت

في ١٤‏/٦‏/٢٠١٦ at 20:54, أيمن ابراهيم said:

اسم المستخدم ayman السري 2010

تسجيل الدخول

المســـاعدة في كــــود نســـخ ولصـــق

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

أيمن ابراهيم

omar elhosseini

أيمن ابراهيم

ياسر العربى

أيمن ابراهيم

ياسر العربى

أيمن ابراهيم

ياسر العربى

أيمن ابراهيم

ياسر العربى

asdhamdey

asdhamdey

ياسر العربى

asdhamdey

أيمن ابراهيم

asdhamdey

asdhamdey

أيمن ابراهيم

asdhamdey

ياسر العربى

ياسر العربى

أيمن ابراهيم

ياسر العربى

أيمن ابراهيم

asdhamdey

Join the conversation

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

تصفح الموقع

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

Support

Important Information