asdhamdey قام بنشر مايو 1, 2015 مشاركة قام بنشر مايو 1, 2015 الاستاذ الكريم عبد الباري هيا بنا نبحر في عملك القوي ليكون درسا للمهتمين بهذا المجال وليكون لك ولنا ان شاء الله عمل صالح ينتفع به في صفحة بيانات اساسيه وجدنا الكتابة بالخط البارز كيف تم ذلك في صفحة الشيت الورقي يوجد زر سحري اسمه تحديث وكوده الاتي On Error GoTo kh_Err تصفير_محدد kh_Application False '============================================= kh_cFormula Range("شيت_الصف_الرابع!$c$2:$g$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$k$2:$L$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$p$2:$t$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$x$2:$y$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ac$2:$ag$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ak$2:$al$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ap$2:$at$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ay$2:$ba$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$bf$2:$bk$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$bo$2:$bp$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$bt$2:$bx$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ca$2:$cb$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ce$2:$ci$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$cl$2:$cm$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$cp$2:$ct$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$cw$2:$cx$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$da$2:$de$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$dh$2:$di$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$dl$2:$dr$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$dv$2:$dw$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$ea$2:$ek$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$em$2:$em$2"), 7, ورقة8.Range("b1") kh_cFormula Range("شيت_الصف_الرابع!$eo$2:$ew$2"), 7, ورقة8.Range("b1") '============================================= kh_Err: kh_Application True If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear ' Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله" End If End Sub ' MyRng : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة ' iRow : اول صف للبيانات ' Lastrow : آخر صف للبيانات Sub kh_cFormula(MyRng As Range, iRow As Integer, Lastrow As Long) Dim Col As Range Dim R As Long '======================== For Each Col In MyRng.Cells If Col.HasFormula Then For R = iRow To Lastrow With MyRng.Worksheet .Cells(R, Col.Column).FormulaR1C1 = Col.FormulaR1C1 .Cells(R, Col.Column).Value = .Cells(R, Col.Column) End With Next R End If Next '======================== Set Col = Nothing End Sub Sub kh_Application(ibol As Boolean) With Application .ScreenUpdating = ibol .Calculation = IIf(ibol, -4105, -4135) .EnableEvents = ibol End With End Sub نرجو شرحه بارك الله فيك وجغل هذا العمل من باب علم ينتفع به اخى الحبيب قصى هذا الكود .... مسئول عن نسخ المعادلات الموجوده فى الصف الثانى ذو اللون الاسود وتطبيقها على باقى الشيت ابتداء من الصف السابع واذا اردت شرحا وافيا ....حاضر من عينيا هذا الكود .... مسئول عن نسخ المعادلات الموجوده فى الصف الثانى اريد اضافة نسخ التنسيقات الموجوده بنفس الصف الثاني جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 1, 2015 مشاركة قام بنشر مايو 1, 2015 الأخ الفاضل يرجى مراجعة هذا الرابط وتطبيق التوجيهات http://www.officena.net/ib/index.php?showtopic=60147 ولن يلتفت إليك الأخوة الأعضاء ما دمت لم تلتفت إلى التوجيهات (هااااام وضروري) رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 هذا الكود موجود بهذا الموضوع http://www.officena.net/ib/index.php?showtopic=58577&page=3 المشاركة 43 رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 (معدل) الأخ الفاضل يرجى مراجعة هذا الرابط وتطبيق التوجيهات http://www.officena.net/ib/index.php?showtopic=60147 ولن يلتفت إليك الأخوة الأعضاء ما دمت لم تلتفت إلى التوجيهات (هااااام وضروري) انت خلاص قررت ان الاخوة لا يلتفتوا الى موضوعي .. عرفني ايه الحكايه الله يسامحك تم تعديل مايو 1, 2015 بواسطه asdhamdey رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 1, 2015 مشاركة قام بنشر مايو 1, 2015 والله أخي الفاضل حمدي إنت حر أنا مش بلزمك بشيء ومحدش يقدر يلزمك .. بس طالما إن فيه قواعد .. يبقا صدقني الأخوة اللي بيقدموا المساعدة هيلتزموا بيها قبل الأعضاء اللي بيطلبوا المساعدة نفسهم ..دا لأنك لو ساعدت الناس الناس هتساعدك حاجة تانية (ومش غرور مني لكن ثقة في الأعضاء ) - لو قلت بلاش نساعد فلاااااااان كله هيسمع كلامي .دا عشمي فيهم مش إجبار ليهم بردو راجع التوجيهات بارك الله فيك والتزم بما جاء فيها قبل أي شيء ..ولو وجدت شيء لا يعجبك فيها أخبرني رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 هذا هو الملف المطلوب الصف رقم 1000 به معادلات واطارات اريد نسخه بمعادلاته وتنسيقاته في من الصف ال11 وحتى نهايه العدد الموجود في الخليه B4 وشكرا لتوجيهاتكم يابو ضحكة جنان نسخ المعادلات والتنسيقات.zip رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 عدد الصغوف او عدد الطلاب متغير رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 Sub kh_Copy_Formula() On Error GoTo kh_Err kh_Application False '============================================= kh_cFormula Range("الاول!$b$5:$b$5"), 9, ورقة19.Range("b1") kh_cFormula Range("الاول!$n$5:$u$5"), 9, ورقة19.Range("b1") '============================================= kh_Err: kh_Application True If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear ' Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله" End If End Sub ' MyRng : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة ' iRow : اول صف للبيانات ' Lastrow : آخر صف للبيانات Sub kh_cFormula(MyRng As Range, iRow As Integer, Lastrow As Long) Dim Col As Range Dim R As Long '======================== For Each Col In MyRng.Cells If Col.HasFormula Then For R = iRow To Lastrow With MyRng.Worksheet .Cells(R, Col.Column).FormulaR1C1 = Col.FormulaR1C1 .Cells(R, Col.Column).Value = .Cells(R, Col.Column) End With Next R End If Next '======================== Set Col = Nothing End Sub Sub kh_Application(ibol As Boolean) With Application .ScreenUpdating = ibol .Calculation = IIf(ibol, -4105, -4135) .EnableEvents = ibol End With End Sub Sub kh_Copy_Formula1() On Error GoTo kh_Err kh_Application1 False '============================================= kh_cFormula Range("الثانى!$b$5:$b$5"), 9, ورقة20.Range("b1") kh_cFormula Range("الثانى!$n$5:$u$5"), 9, ورقة20.Range("b1") '============================================= kh_Err: kh_Application1 True If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear ' Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله" End If End Sub ' MyRng : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة ' iRow : اول صف للبيانات ' Lastrow : آخر صف للبيانات Sub kh_cFormula1(MyRng As Range, iRow As Integer, Lastrow As Long) Dim Col As Range Dim R As Long '======================== For Each Col In MyRng.Cells If Col.HasFormula Then For R = iRow To Lastrow With MyRng.Worksheet .Cells(R, Col.Column).FormulaR1C1 = Col.FormulaR1C1 .Cells(R, Col.Column).Value = .Cells(R, Col.Column) End With Next R End If Next '======================== Set Col = Nothing End Sub Sub kh_Application1(ibol As Boolean) With Application .ScreenUpdating = ibol .Calculation = IIf(ibol, -4105, -4135) .EnableEvents = ibol End With End Sub استاذ ياسر آدي الكود والملف .. مبسوط ياعم عملت اللي عليا .. همتك بقى رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 للرفع رفع الله قدركم رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 1, 2015 الكاتب مشاركة قام بنشر مايو 1, 2015 المسامح كريم رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 1, 2015 مشاركة قام بنشر مايو 1, 2015 أخي الكريم الملف يحتاج لوقت لدراسته .. إن شاء الله تجد المساعدة من الأخوة الأعضاء .. وبعدين مفيش حد زعلان منك أبداً تقبل تحياتي رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 للرفع رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 رابط به كود لنسخ صف ارجو تعديله ليتلاءم معنا http://www.officena.net/ib/index.php?showtopic=31449 رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 وهذا هو الكود 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 Last = .Range("A" & .Rows.Count).End(xlUp).Row .Rows(Last).Copy .Rows(Last + 1).Resize(Count) .Rows(Last + 1).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 Option Explicit '****************************************************** ' تعيين نطاق الخلايا التي يتم نسخها Private Const MyRng_Copy As String = "B4:I4" '------------------------------------------------------ ' MyRng_Copy تعيين رقم العمود من النطاق ' الذي سياخذ منه آخر صف للصق Private Const MyColumn As Integer = 4 '****************************************************** Sub Kh_Insert_Rows() On Error Resume Next Dim MyRow As Integer, LastRow As Integer MyRow = 1 MyRow = Application.InputBox(Prompt:=" ادخل عدد الصفوف " & Chr(10) & "عدد الصفوف الافتراضية " & MyRow, Title:="ادراج عدد محدد من صفوف ", Default:=MyRow, Type:=1) If MyRow = False Then Exit Sub With Range(MyRng_Copy) LastRow = Range(.Cells(1, MyColumn), .Cells(1, MyColumn).End(xlDown)).Rows.Count If LastRow = 0 Then LastRow = 1 .Copy With .Offset(LastRow, 0).Resize(MyRow, .Columns.Count) .PasteSpecial xlPasteAll .SpecialCells(xlCellTypeConstants).ClearContents End With .Columns(1).Offset(LastRow, 0).Select End With Application.CutCopyMode = False MsgBox "تم ادراج الصفوف المطلوبة بنجاح", 524288 + 1048576, "الحمدلله" On Error GoTo 0 End Sub ------------------------------------------------------------------- Sub Kh_Clear_Rows() On Error Resume Next Dim LastRow As Integer With Range(MyRng_Copy) LastRow = Range(.Cells(1, MyColumn), .Cells(1, MyColumn).End(xlDown)).Rows.Count .SpecialCells(xlCellTypeConstants).ClearContents If LastRow = 0 Then GoTo 1 .Cells(2, 1).Resize(LastRow, .Columns.Count).Clear End With 1: MsgBox "تم المسح بنجاح", 524288 + 1048576, "الحمدلله" On Error GoTo 0 End Sub هذا كود اخر لو تكرمتم اريد الحل في ملفي رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 وهذا رابط الكود http://www.officena.net/ib/?showtopic=33712 رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 المطلوب من كل هذه الاكواد المفيدة بارك الله في صانعها هو مطلوب كود منهم يتم تطويعه لينسخ الصف 1000 الموجود بالملف ويتم لصقة ابتداء من الصف ال11 بالعدد الموجود في الخليه B4 بنفس معادلاته وتنسيقاته جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
عبدالباري البنا قام بنشر مايو 2, 2015 مشاركة قام بنشر مايو 2, 2015 الاخ العزيز .....تفضل الملف اجريت تعديل بسيط وهو تغيير الصف المراد نسخه من الصف 1000 الى الصف 11 تقبل تحياتى نسخ المعادلات والتنسيقات.rar رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 يبارك فيك ربنا يا استاذ عبد الباري اولا يجب شكرك ثانيا عند تغيير عدد الطلاب الموجود في الخليه بي 4 المفروض ان يوجد هذا العدد من الصفوف فقط مملوءه بالمعادلات والتنسيقات الصف ال1000 ليه هو المطلوب من اجل ان يتم الاستفاده القصوى من الكود لجميع الكنترولات فبعضهم يبدأ من الصف 7 والاخر من الصف 11 والرقم متغير اذن افضل حل هو الصف ال1000 رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 2, 2015 الكاتب مشاركة قام بنشر مايو 2, 2015 لو ان عدد الطلاب 500 وبعد كده اردنا ان ندخل عدد الطلاب 100 فإن الصفوف ال500 تظل مملوءه بالمعادلات نريد ان يلتزم الكود بعدد الطلاب فقط وتمسح الصفوف الغير ذلك رابط هذا التعليق شارك More sharing options...
عبدالباري البنا قام بنشر مايو 2, 2015 مشاركة قام بنشر مايو 2, 2015 لو ان عدد الطلاب 500 وبعد كده اردنا ان ندخل عدد الطلاب 100 فإن الصفوف ال500 تظل مملوءه بالمعادلات نريد ان يلتزم الكود بعدد الطلاب فقط وتمسح الصفوف الغير ذلك أخى العزيز جرب المرفق سوف يقوم بنسخ العدد المطلوب فقط ويمسح باقى الصفوف نسخ المعادلات والتنسيقات.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 2, 2015 مشاركة قام بنشر مايو 2, 2015 بارك الله فيك أخي وحبيبي في الله عبد الباري كنت في بالي والله .. غبت عننا ليه لعله خير إن شاء الله ننتظر تواجدك معنا وبيننا رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر مايو 3, 2015 الكاتب مشاركة قام بنشر مايو 3, 2015 استاذ عبد الباري انا ارشحك لكي تكون مشرفا بالمنتدى العظيم شرف للمنتدى مثلك .. الملف ممتاز ولكنه لايعمل بعد تغيير عدد الطلاب اكثر من 4 محاولات جرب وشوف رابط هذا التعليق شارك More sharing options...
عبدالباري البنا قام بنشر مايو 3, 2015 مشاركة قام بنشر مايو 3, 2015 اخى العزيز اشكرك جدا على كلماتك الجميله لكنى اقل بكثير من ان اتساوى باساتذة هذا الصرح العظيم ============== جرب المرفق بعد التعديل واعلمنى بالنتيجة نسخ المعادلات والتنسيقات.rar رابط هذا التعليق شارك More sharing options...
عبدالباري البنا قام بنشر مايو 3, 2015 مشاركة قام بنشر مايو 3, 2015 بارك الله فيك أخي وحبيبي في الله عبد الباري كنت في بالي والله .. غبت عننا ليه لعله خير إن شاء الله ننتظر تواجدك معنا وبيننا اخى واستاذى وحبيبى فى الله.... استاذ ياسر اولا : مبروك لهذا المنتدى الرائع ترقيه استاذ كبير وعظيم مثلك وصاحب ايادى بيضاء على الجميع...مبروك ثانيا : والله بجد وحشتونى جدا وما منعنى كان اقوى منى لكن الحمد لله قدر الله وما شاء فعل ثالثا : اسعدنى جدا جدا جدا سؤالك عنى ....ادام الله الحب والموده بيننا وادام الله عليك فضله ونعمته 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.