الشيباني1 قام بنشر يناير 12, 2011 قام بنشر يناير 12, 2011 اخواني الاعزاء تحية طيبه في المرفق طريقة حماية رائعه ارجو المساعده في عمل زر لتفعيل الماكرو وآخر للالغاء مع الامتنان Book10.zip
عادل حنفي قام بنشر يناير 12, 2011 قام بنشر يناير 12, 2011 السلام عليكم اخي جرب المرفق تحياتي Book11.rar
الشيباني1 قام بنشر يناير 12, 2011 الكاتب قام بنشر يناير 12, 2011 استاذنا العزيز اشكرك وادامك الرحمن لنا منقذا
الشيباني1 قام بنشر يناير 13, 2011 الكاتب قام بنشر يناير 13, 2011 استاذنا الكريم تحية طيبه دعت الضرورة لتنفيذ الاكواد الرائعه على عدة اوراق ضمن الملف ما الذي يجب تعديله للوصول الى الغاية المطلوبه مع الامتنان
عادل حنفي قام بنشر يناير 13, 2011 قام بنشر يناير 13, 2011 السلام عليكم اخي الفاضل بهذا التعديل يتم عمل الكود علي كل اوراق الملف تحياتي Book12.rar
الشيباني1 قام بنشر يناير 13, 2011 الكاتب قام بنشر يناير 13, 2011 استاذنا العزيز اشكرك جدا على ما تجود به وطلبي هو ان تشمل الحماية مديات لا تشابه ما تضمنته الورقة الاولى ( اي ان المديات المحميه ليست متشابهه في كافة الاوراق ) كأن تكون في (J5:l30,m5:o50) وهكذا ، هل يتطلب الموضوع مثالا جديدا ارفقه مع الامتنان
عبدالله باقشير قام بنشر يناير 13, 2011 قام بنشر يناير 13, 2011 السلام عليكم الشكر واصل للاخ الحبيب عادل حفظه الله ولاثراء الموضوع اضفنا زر تشييك في الورقة AA باسم "ok_off" عن طريقه يتم التحكم في الحماية يوضع الكود التالي في الوحدة النمطية ThisWorkbook Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Worksheets("AA").Shapes("ok_off").ControlFormat.Value = xlOn Then Set MyTarget = Nothing If Sh.Name = "AA" Then Set MyTarget = Sh.Range("B2:B30,D2:G30") If Sh.Name = "BB" Then Set MyTarget = Sh.Range("D5:E10") If Sh.Name = "DD" Then Set MyTarget = Sh.Range("E4:E10") If Not MyTarget Is Nothing Then If Not Intersect(Target, MyTarget) Is Nothing Then Sh.Cells(Target.Row, 1).Select End If Set MyTarget = Nothing End If End Sub شاهد المرفق كود حماية خلايا.rar
عادل حنفي قام بنشر يناير 13, 2011 قام بنشر يناير 13, 2011 السلام عليكم الاخ الحبيب خبور خير سلمت يداك و بارك الله فيك خالص تحياتي و تقديري
الشيباني1 قام بنشر يناير 14, 2011 الكاتب قام بنشر يناير 14, 2011 اساتذتنا الكرام جزاكم الله كل خير فقد ابدعتم وانقذتم ادامكم الرحمن لنا مرجعا
الشيباني1 قام بنشر يناير 15, 2011 الكاتب قام بنشر يناير 15, 2011 استاذنا الكريم تحية طيبه خانتني الذاكرة في كيفية نقل زر التفعيل الرائع وكوده من الورقة الحاليه الى البرنامج الذي اعمل عليه ارجو المساعده مع الامتنان
الشيباني1 قام بنشر يناير 16, 2011 الكاتب قام بنشر يناير 16, 2011 استاذي العزيز تحية طيبه ارجو ان يسع وقتكم طلبي مع الامتنان
عادل حنفي قام بنشر يناير 16, 2011 قام بنشر يناير 16, 2011 السلام عليكم اخي ولد المجرب استاذنا الكريم تحية طيبه خانتني الذاكرة في كيفية نقل زر التفعيل الرائع وكوده من الورقة الحاليه الى البرنامج الذي اعمل عليه ارجو المساعده مع الامتنان اخي في الملف الذي به الزر اجعل الوضع في وضع التصميم و اضغط غلي الزر مرتان ليظهر لك كوده لتنسخه وتذهب لملفك و ادرج زر و تضغط عليه مرتان و تلصق ما تم نسخه و يتم ذلك ايضا بالنسبة للزر الاخر ولا تنسي وضع الكود التالي في thisworkbook Private Sub Workbook_Open() Sheets("ورقة1").Range("v1000") = 1 End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Sheets("ورقة1").Range("V1000") = 1 Then If Not Intersect(Target, ActiveSheet.Range("b2:b30,d2:g30")) Is Nothing Then Cells(Target.Row, 1).Select End If End Sub جرب و اخبرني النتيجة تحياتي
الشيباني1 قام بنشر يناير 17, 2011 الكاتب قام بنشر يناير 17, 2011 استاذنا الكبير تحية طيبه في المشاركه رقم(6)اوضحت طلبي حول امكانية شمول الحمايه اي مدى في اية ورقه بلا تحديد والاجراءات التي تفضلتم بها كانت قد انجزت وعمل الكود بطريقته الرائعه ولكن بمدى محدد لكل الاوراق ثم جاد الاستاذ خبور بكود رائع لم استطع اتخاذ ما يلزم ليعمل لنسياني الطريقه التي بها يتم نقل زر التفعيل الى البرنامج الذي اعمل عليه. اتمنى ان يكون هناك زران ( للتفعيل والغاءه )مع الامتنان.
عبدالله باقشير قام بنشر يناير 17, 2011 قام بنشر يناير 17, 2011 السلام عليكم اخي بعد وضع الكود في الوده النمطية يوضع الكود التالي في الوحدة النمطية ThisWorkbook Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Worksheets("AA").Shapes("ok_off").ControlFormat.Value = xlOn Then Set MyTarget = Nothing If Sh.Name = "AA" Then Set MyTarget = Sh.Range("B2:B30,D2:G30") If Sh.Name = "BB" Then Set MyTarget = Sh.Range("D5:E10") If Sh.Name = "DD" Then Set MyTarget = Sh.Range("E4:E10") If Not MyTarget Is Nothing Then If Not Intersect(Target, MyTarget) Is Nothing Then Sh.Cells(Target.Row, 1).Select End If Set MyTarget = Nothing End If End Sub قم من خلاله بتغيير اساء اللاوراق التي تريدها والنطاقا ت التي تريد ها التي تريده لهذه الاورق ام الزر قم بنسخه من الملف ولصقه في اي ورقة ترديها وغير اسم هذه الورقة في الكود
الشيباني1 قام بنشر يناير 18, 2011 الكاتب قام بنشر يناير 18, 2011 اشكرك استاذنا الكبير ويظهر ان هناك خللا" في اجراءاتي يمنع عمل الكود اتساءل عن وجود طريقة اخرى احل بها مشكلتي مع الامتنان
عبدالله باقشير قام بنشر يناير 18, 2011 قام بنشر يناير 18, 2011 السلام عليكم ويظهر ان هناك خللا" في اجراءاتي يمنع عمل الكود اتساءل عن وجود طريقة اخرى احل بها مشكلتي مع الامتنان احتمالات المشكلة قد تكون في التالي: 1- اسم الورقة التي فيها الزر غير صحيح 2- اسم الزر غير صحيج 3- اسماء الاوراق التي فيها الخلايا غير صحيحة لا تياس سريعا اخي حاول ثم حاول ثم حاول ثم اعد تكرار المحاولة من جديد وبعدها سياتي النجاح ودمتم في حفظ الله
الشيباني1 قام بنشر يناير 19, 2011 الكاتب قام بنشر يناير 19, 2011 استاذنا الكبير اشكرك جدا وادامك الرحمن لنا مرجعا
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.