ناصر سعيد قام بنشر مارس 26, 2016 مشاركة قام بنشر مارس 26, 2016 السلام عليكم ورحمة الله وبركاته اخواني في الله هذا الملف به كود لاحد عمالقة المنتدى وهو الاستاذ ابو تامر بارك الله له ولكم والكود يعمل جيدا ولكنه يعمل بادراج الصفوف من مواقع مختلفه والملف خاصتي به عدة اوراق اريد جزاكم الله خيرا ان يعمل هذا الكود من موقع ثابت دائما كما في الصفحات وان ياخذ العدد من صفحة بيانات اساسيه ادراج عدد محدد من الصفوف بصيغ الصف الحالى فى اوراق محددة.rar Option Base 1 Sub Test() MySheets = Array("ورقة1", "ورقة2", "ورقة3") R = ActiveCell.Row Count = 2 If vRows = 0 Then Count = Application.InputBox(Prompt:=" ادخل عدد الصفوف ", Title:=" ادراج عدد محدد من صفوف ", Default:=1, Type:=1) If Count = False Then Exit Sub End If Application.ScreenUpdating = False For x = 1 To UBound(MySheets) Sheets(MySheets(x)).Select Rows(R).Offset(1, 0).Resize(Count).EntireRow.Insert: Rows(R).AutoFill Rows(R).Resize(Count + 1), xlFillDefault Rows(R).Offset(1).Resize(Count).EntireRow.SpecialCells(xlConstants).ClearContents Next Sheets(MySheets(1)).Select Application.ScreenUpdating = True End Sub الكود هو رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مارس 26, 2016 مشاركة قام بنشر مارس 26, 2016 أخي الكريم ناصر الكود غير متوافق مع الملف المرفق ..يرجى إرفاق الملف الأصلي الذي يحتوي كود أ / تامر للإطلاع عليه ودراسته أولاً .. أو قم بالإشارة إلى الموضوع المقتبس منه الكود تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر مارس 26, 2016 الكاتب مشاركة قام بنشر مارس 26, 2016 شكرا لردك ربنا يبارك فيك هذا هو رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مارس 27, 2016 مشاركة قام بنشر مارس 27, 2016 أخي الكريم ناصر اطلعت على الموضوع وفهمت الفكرة من الكود لكن لم أفهم المطلوب بالنسبة لك بشكل تام وضح بشكل تفصيلي ما هي اوراق العمل المراد العمل عليها ؟ وما هي شروطك ؟ وما هي حيثيات الطلب بالضبط؟ تقبل تحياتي 2 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر مارس 27, 2016 الكاتب مشاركة قام بنشر مارس 27, 2016 جزاك الله كل خير اخي المحترم ياسر خليل في صفحة بيانات اساسيه يوجد عدد في الخليه B10 هذا العدد متغير لانه عدد طلبه الصف الدراسي وكل صف دراسي له عدد مختلف ... في صفحة بيانات الطلبه يوجد زر مكتوب عليه نسخ البيانات بعدد الطلاب المطلوب : عند الضغط على هذا الزر الموجود بصفحة بيانات الطلبه يتم نسخ الصف السابع في جميع الاوراق الموجوده بالملف ماعدا ورقة كنترول شيت سيكون النسخ من الصف 12 بالطبع لن يكون النسخ للصف كاملا وانما بطول الراس الموجوده في كل صفحة بمعنى آخر يوجد في كل صفحة راس مسطره ومكتوب بها بيانات ..... تحتها مباشرة يوجد صف هذا الصف هو المطلوب بسخه بعدد الطلاب وبعرض راس الصفحة وشكرا مقدما رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر مارس 27, 2016 الكاتب مشاركة قام بنشر مارس 27, 2016 للرفع رفع الله مقداركم رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مارس 27, 2016 مشاركة قام بنشر مارس 27, 2016 أتعني أنك تريد الاستغناء عن صندوق الإدخال الموجود في الكود الأصلي لأبو تامر والاعتماد على القيمة 888 في ورقة بيانات المدرسة .. المشكلة أن أوراق العمل لديك لا تبدأ كلها بنفس الصف المراد نسخه وهذا ما يصعب الأمر ... إن شاء الله سأعمل على ملفك إذا تيسر لي الوقت تقبل تحياتي رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر مارس 27, 2016 الكاتب مشاركة قام بنشر مارس 27, 2016 نعم اخي الكريم اريد الاستغناء عن صندوق الادخال والاعتماد على الزر الذي يجلب عدد الصفوف من صفحة بيانات المدرسه لان 888 متغير بارك الله لك رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر مارس 27, 2016 الكاتب مشاركة قام بنشر مارس 27, 2016 Sub KH_Copy() On Error Resume Next Dim Last As Long Dim Count As Integer Count = 1 Count = Sheets("KHBOOR").Range("F9").Value With ActiveSheet A = .Cells(1, 1).End(xlDown).Offset(2, 0).Row .Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete Last = .Range("A" & .Rows.Count).End(xlUp).Row .Rows(Last).Copy .Rows(Last).Resize(Count) .Rows(Last).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub هل يمكن تطويع هذا الكود ليعمل في ملقي المرفق بالمشاركة الاولى نسخ صفوف بعدد معين مع الاحتفاظ بالمعادلات.rar عايز اي حل يا احبابي رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مارس 27, 2016 مشاركة قام بنشر مارس 27, 2016 أخي الكريم ناصر إليك شرح الكود الأخير لتتمكن من تطويعه لخدمة ملفك Sub KH_Copy() 'الإعلان عن المتغيرات Dim Last As Long, A As Long Dim Count As Integer 'سطر لتفادي حدوث خطأ في حالة أن الخلايا التي سيتم مسحها أي الخلايا الثابتة كانت فارغة On Error Resume Next 'تعيين قيمة للمتغير ليساوي 1 Count = 1 '[F10] تعيين قيمة للمتغير ليساوي قيمة الخلية Count = Sheets("KHBOOR").Range("F10").Value 'بدء التعامل مع ورقة العمل النشطة With ActiveSheet 'تعيين رقم الصف الذي يمثل أول صف فارغ بعد آخر صف به بيانات A = .Cells(1, 1).End(xlDown).Offset(2, 0).Row 'حذف صفوف النطاق بداية من الصف رقم 13 .Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete 'تعيين آخر صف به بيانات وهو الصف رقم 12 والذي يعتبر أول صف به المعادلات المطلوب نسخها Last = .Range("A" & .Rows.Count).End(xlUp).Row 'نسخ الصف الهدف بامتداد قيمة المتغير أي بالعدد المحدد أو العدد المطلوب .Rows(Last).Copy .Rows(Last).Resize(Count) 'مسح الثوابت والإبقاء على المعادلات .Rows(Last).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub ها هو الشرح طالما أن الأخوة يعجزون عن تقديم حل للموضوع .. تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ابن بنها قام بنشر مارس 28, 2016 مشاركة قام بنشر مارس 28, 2016 (معدل) Sub MacroFil1() Application.ScreenUpdating = False Sheets("بيانات الطلبة").Range("a7:o7").Select Selection.AutoFill Destination:=Range("a7:o" & ['الرئيسية'!s12] + 6) Sheets("رصد نصف العام").Select Range("a7:n7").Select Selection.AutoFill Destination:=Range("a7:n" & ['الرئيسية'!s12] + 6) Sheets("ملف الإنجاز1 ").Select Range("a7:k7").Select Selection.AutoFill Destination:=Range("a7:k" & ['الرئيسية''!s12] + 6) Sheets("رصد آخر العام ").Select Range("a7:cd7").Select Selection.AutoFill Destination:=Range("a7:cd" & ['الرئيسية'!s12] + 6) Sheets("بيانات الطلبة").Select Range("A4").Select Application.ScreenUpdating = True End Sub اخي الكريم ناصر سعيد وجدت الحل في احدى مشاركات الاخوة الكرام في هذا الرابط والكود المستخدم له فكره اخرى ولكن تؤدي نفس الغرض الذي تريده ان شاء الله Sub MacroFil1() Application.ScreenUpdating = False Sheets("بيانات الطلبة").Range("a7:o7").Select Selection.AutoFill Destination:=Range("a7:o" & ['الرئيسية'!s12] + 6) Sheets("رصد نصف العام").Select Range("a7:n7").Select Selection.AutoFill Destination:=Range("a7:n" & ['الرئيسية'!s12] + 6) Sheets("ملف الإنجاز1 ").Select Range("a7:k7").Select Selection.AutoFill Destination:=Range("a7:k" & ['الرئيسية''!s12] + 6) Sheets("رصد آخر العام ").Select Range("a7:cd7").Select Selection.AutoFill Destination:=Range("a7:cd" & ['الرئيسية'!s12] + 6) Sheets("بيانات الطلبة").Select Range("A4").Select Application.ScreenUpdating = True End Sub شرح للكود السطر الأول فى الكود هو اسم الماكرو السطر الثانى هو إلغاء تحديث الشاشة (الغاء مشاهدة تنفيذ الماكرو) السطر الثالث تحديد البيانات الموجودة فى أول صف من صفوف بيانات الطلاب من الخلية (a7)إلى الخلية (o7) السطر الرابع نسخ المعادلات والدوال الموجود فى المدى السابق بعدد الطلاب الموجود فى الصفحة الرئيسية من السطر الخامس حتى السطرالثالث عشر تكرار نفس عمليتى التحديد والنسخ فى الصفحات ( رصد نصف العام - ملف الإنجاز1 - رصد آخر العام ) حتى تكون الصفحات جاهزة لأستقبال وربط البيانات السطر الرابع عشر الرجوع إلى صفحة بيانات الطلبة السطر الخامس عشر الوقوف فى الخلبة (a4) السطر السادس عشر عكس السطر الثانى السطر السابع عشر نهاية الكود وحيث إنك من رجال التربية والتعليم أهديك هذا الكود وهو من تراث المنتدى الطيب برجاله Sub إظهار() Dim Answer As String Answer = InputBox(" فضلاَ أدخل كلمة المرور ") If Answer <> Sheets("بيانات الطلبة").Range("S2") Then MsgBox "كلمة المرور غير صحيحة ولم يتم تنفيذ المطلوب " Exit Sub End If MsgBox "كلمة المرور صحيحة وسيتم تنفيذ المطلوب " Columns("c:d").Select Selection.EntireColumn.Hidden = False Columns("s:s").Select Selection.EntireColumn.Hidden = True Range("b7").Select End Sub تم تعديل مارس 28, 2016 بواسطه ابن بنها تنسيق الكتابه رابط هذا التعليق شارك More sharing options...
ابن بنها قام بنشر مارس 28, 2016 مشاركة قام بنشر مارس 28, 2016 رابط سيفيدك في عمل كنترول لمدرستك ودعواتنا للجميع بالخير http://www.officena.net/ib/profile/16499-%D8%B9%D8%A7%D8%AF%D9%84-%D8%AC%D9%84%D8%A7%D9%84/?do=content&page=1 رابط هذا التعليق شارك More sharing options...
ابن بنها قام بنشر مارس 28, 2016 مشاركة قام بنشر مارس 28, 2016 اريد ان احعل هذا في توقيعي .. كيف http://up.top4top.net/downloadf-top4...b00a1-rar.html خطوط البسملهhttp://up.top4top.net/downloadf-top4...ca0c1-rar.html خطوط الخطاطhttp://www.arfonts.net/?c=diwan&t=symbol خطوط الديوانيhttp://www.arfonts.net/?c=thuluth خطوط الثلثhttp://www.arfonts.net/?c=naskh رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مارس 28, 2016 مشاركة قام بنشر مارس 28, 2016 أخي الكريم راجع موضوع التوجيهات في الموضوعات المثبتة في المنتدى .. ربما تجد طريقة عمل المطلوب .. التوجيه العاشر الخاص بتغيير اسم الظهور ، ستجد التوقيع في تبويب في نفس الصفحة رابط هذا التعليق شارك More sharing options...
ابن بنها قام بنشر مارس 29, 2016 مشاركة قام بنشر مارس 29, 2016 في ٢٨/٣/٢٠١٦ at 15:24, ابن بنها said: اريد ان احعل هذا في توقيعي .. كيف http://up.top4top.net/downloadf-top4...b00a1-rar.html خطوط البسملهhttp://up.top4top.net/downloadf-top4...ca0c1-rar.html خطوط الخطاطhttp://www.arfonts.net/?c=diwan&t=symbol خطوط الديوانيhttp://www.arfonts.net/?c=thuluth خطوط الثلثhttp://www.arfonts.net/?c=naskh كما ترون احبابي ان لي توقيعا بالمنتدى لكني اريد توقيعي به الروابط السابقة ومش عارف .. اريد الحل جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مارس 29, 2016 مشاركة قام بنشر مارس 29, 2016 أخي الكريم ناصر سعيد المشكلة في ملفك وجود الخلايا المدمجة في رأس العمود في أوراق العمل مما يسبب مشاكل مع الكود .. الرجاء محاولة بناء الملف بدون خلايا مدمجة لأنها تتعارض مع الأكواد ..لأنه من المعروف أن الدمج عدو الأكواد .. ولاحظ الملفات التي قمت بإرفاقها لا يوجد فيها دمج ...أو كحل آخر يمكن إدراج صف تحت الخلايا المدمجة ثم تخفيه فيما بعد .. ويكون هذا الصف هو الأساس .. وسؤال هل هناك أوراق عمل أخرى غير الموجودة في ملفك المرفق أم لا ؟؟ ولما تريد تطبيق الكود على كل أوراق العمل مرة واحدة ؟هل هذا سييسر عليك العمل ؟؟؟ لأنه يمكن التعامل مع الكود بورقة عمل واحدة .. والمشكلةا لأخرى ان الصف المراد نسخه غير ثابت أي متغير .. وهذا مما يصعب الوصول لحل .. 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر أبريل 1, 2016 الكاتب مشاركة قام بنشر أبريل 1, 2016 تقضل استاذ ياسر المرفق بدون دمج اريد تطبيق الكود على جميع الاوراق الموجوده بالمرفق لتسهيل العمل وليجعل الملف خقيف الحجم وجزاك الله خيرا 1ادراج عدد محدد من الصفوف 2.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 1, 2016 مشاركة قام بنشر أبريل 1, 2016 أخي العزيز ناصر سعيد إليك الكود التالي عله يفي بالغرض حمل الكود من هنا تحمل الإعلانات لمدة دقيقة واحدة فقط .. لقد استغرق الكود مني أكثر من ساعة لضبطه بحيث يعمل مع ملفك بشكل جيد .. ولا أطلب منك سوى دقيقة واحدة .. أعتذر إليك تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر أبريل 2, 2016 الكاتب مشاركة قام بنشر أبريل 2, 2016 جزاك الله خيرا مش عارف احمل الكود الموقع ...... ارجو وضع الكود مباشره في المنتدى او http://www.up-00.com/ ولك خالص شكري وتقديري رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر أبريل 2, 2016 الكاتب مشاركة قام بنشر أبريل 2, 2016 جزاك الله خيرا مش عارف احمل الكود الموقع ...... ارجو وضع الكود مباشره في المنتدى او http://www.up-00.com/ ولك خالص شكري وتقديري او احد الاحوه اللي نجحوا في تحميل الكود يعيد رفعه ويجزيه الله خيرا رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 2, 2016 مشاركة قام بنشر أبريل 2, 2016 تفضل أخي الكريم رغم أن الموضوع بسيط ..بيظهر معاك كذا صفحة بتنتظر لمدة 5 ثواني وتضغط على Skip Ad .. ودا بيتكرر 4 أو 5 مرات (كنوع من الدعم البسيط لي) عموماً تفضل الكود وجرب وأعلمني بالنتيجة Sub CopyRow(sSheet As String, sRow As Long, LC As Long) Dim Ws As Worksheet Dim cnt As Long On Error Resume Next Set Ws = Sheets(sSheet) On Error GoTo 0 If Ws Is Nothing Then MsgBox "Sheet " & sSheet & " Doesn't Exist In The Workbook.", vbExclamation, "Sheet Not Found!" Exit Sub End If cnt = Sheets("بيانات المدرسة").Range("B10").Value Ws.Range(Ws.Cells(sRow, 1), Ws.Cells(sRow, LC)).Copy Ws.Range("A" & sRow).Resize(cnt + 1).PasteSpecial xlPasteAll On Error Resume Next Ws.Range("A" & sRow + 1).Resize(cnt, LC).SpecialCells(xlCellTypeConstants, 3).ClearContents Application.CutCopyMode = False End Sub Sub DoIt() CopyRow "بيانات الطلبة", 7, 19 CopyRow "إنجاز1", 7, 15 CopyRow "رصد الترم الأول", 7, 29 CopyRow "أعمال السنة", 7, 15 CopyRow "رصد الترم الثانى", 7, 102 CopyRow "كنترول شيت", 12, 114 End Sub تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر أبريل 2, 2016 الكاتب مشاركة قام بنشر أبريل 2, 2016 راااااااااااااااااااااااائع يا ابو المفهوميه يا استاذ ياسر خليل الكود سريع وسهل .. الله يحفظك ويبارك لك .. الله يحفظك ويبارك لك .. الله يحفظك ويبارك لك ... ولكن بعد اجراء الكود الصفحات تظهر باللون الداكن كأنها محده فممكن لو تكرمت نزيل هذا التحديد ممكن شرح لهذه الاسطر Ws.Range("A" & sRow + 1).Resize(cnt, LC).SpecialCells(xlCellTypeConstants, 3).ClearContents Application.CutCopyMode = False هذه الاكواد ستعمل مع اكواد حمايه .. لعدم التعارض فقط 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 2, 2016 مشاركة قام بنشر أبريل 2, 2016 أخي الكريم ناصر الكود يمكن إضافة أكواد الحماية قبل بداية الأسطر للكود وبعد الأسطر تضع الجماية مرة أخرى السطر المشار إليه يقوم بمسح الخلايا الثابتة في النطاق المنسوخ بحيث يبقى على المعادلات والتنسيق فقط ويزيل ما دون ذلك تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر أبريل 2, 2016 الكاتب مشاركة قام بنشر أبريل 2, 2016 ربنا يبارك لك وموضوع ظهور التحديد هل يمكن ازالته رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أبريل 2, 2016 مشاركة قام بنشر أبريل 2, 2016 يمكن إزالة التحديد ولكن هذا يتطلب تنشيط ورقة العمل وتشيط الخلية A1 مثلاً الأمر بسيط حاول تستخدم السطر التالي Ws.Activate هذا السطر لتنشيط الكود ، والسطر التالي لتنشيط الخلية A1 Range("A1").Activate وإن كنت لا أحبذ استخدام هذه الخاصية .. لأنها تثقل من عمل الكود .. رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان