نجوم المشاركات

كيف نستخدم الدالة لكتابة أرقام متسلسلة من 1 إلى 10 على أن تبدأ في ال الخلية A5؟ الإجابة: i = 1 Do Until i > 10 Cells(i + 4, 1) = i i = i + 1 Loop شاهدالمرفق التالي: do_until_02.rar

الساده / أعضاء المنتدى المحترمين سلام الله عليكم جميعا ورحمته وبركاته قمت بعمل تجميع لعديد من البرامج الجاهزة وقد قمت بتجميعها من خلال البحث فى المنتدى فسامحونى إن كنت نسيت نموذج لأحد الأساتذه الأعضاء نتمنى من الله عز وجل أن ينتفع بها الجميع تلك البرامج و النماذج القيمه هى مجهود للساده الأعضاء بارك الله فيهم وزادهم الله من فضله وجزاهم رب العالمين عنا خير الجزاء وبرامج ونماذج قاموا بتنفيذها بناء على طلبات من الساده الأعضاء وتقبلوا منى وافر الإحترام والتقدير أخيكم فى الله محمود الشريف وإليكم النماذج برنامج متابعه حركة السيارات للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=49733#entry303008 برنامج مصاريف سيارات وأرصده للأستاذ / محمد مصطفى أبو حمزة http://www.officena.net/ib/index.php?showtopic=46058#entry273859 برنامج مراقبة خطابات الضمان للاستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=38044#entry209393 برنامج نظام حركة المستودعات ومتابعة المخزون للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=38870#entry213211 برنامج للعيادات الطبية للأستاذ / مدحت http://www.officena.net/ib/index.php?showtopic=32830#entry169369 برنامج السكرتير الخاص للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=42018#entry239414 برنامج للأقساط _ مجهود مشترك بين الأستاذ / حسام والأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=46619#entry279457 تعديل للبرنامج السابق للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=46619#entry279481 تعديل للبرنامج السابق للاستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=46619#entry279786 برنامج أقساط الإصدار الأول للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=29892#entry148900 برنامج أقساط الإصدار الثانى للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=29892#entry149116 برنامج أقساط الإصدار الثالث للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=29892#entry149553 برنامج أقساط الإصدار الرابع للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=29892#entry150361 برنامج متابعة الوثائق للأستاذ / الجزيرة http://www.officena.net/ib/index.php?showtopic=31712#entry161472 برنامج لقاعده بيانات عمل مشترك بين الأستاذ / قارى _ والأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=44485#entry259617 نموذج أقساط للأستاذ /سايق الخير http://www.officena.net/ib/index.php?showtopic=38538#entry210055 قام بالتعديل عليه الأستاذ / عبد الله المجرب http://www.officena.net/ib/index.php?showtopic=38538#entry210056 قام بالتعديل عليه الأستاذ / بن عليه حاجى http://www.officena.net/ib/index.php?showtopic=38538#entry210084 برنامج المخزون الإصدار الأول للأستاذ / عمرو http://www.officena.net/ib/index.php?showtopic=41247#entry233101 برنامج المخزون الإصدار الثانى للأستاذ / عمرو http://www.officena.net/ib/index.php?showtopic=43332#entry250295 برنامج المخزون الإصدار الثالث للأستاذ / عمرو 2010 http://www.officena.net/ib/index.php?showtopic=46059#entry273864 برنامج المخزون الإصدار الثالث للأستاذ / عمرو 2007 : 2010 http://www.officena.net/ib/index.php?showtopic=46059#entry273864 برنامج مرتبات للقطاع الخاص للأستاذ / سعيد بيرم http://www.officena.net/ib/index.php?showtopic=41465#entry240172 برنامج الصادر والوارد _ الإتصالات الإدارية للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=46813#entry281283 برنامج الإتصالات الإدارية الإصدار الأول للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=37265#entry199078 برنامج الإتصالات الإدارية الإصدار الثانى للأستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=37265#entry199224 برنامج الإتصالات الإدارية الإصدار الأخير للاستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=37265#entry199421 برنامج للتعامل مع طلبات الشراء والموردين للأستاذ / أبو عبد الله http://www.officena.net/ib/index.php?showtopic=30844#entry155312 برنامج حجز الغرف الفندقية عمل مشترك بين الأستاذ / هانى بدر والأستاذ / أبو عبد الله http://www.officena.net/ib/index.php?showtopic=39568&page=2#entry224762 برنامج حسابات المطاعم للأستاذ هانى بدر http://www.officena.net/ib/index.php?showtopic=32220&page=2#entry189567 برنامج دليل الهاتف الإصدار الثانى للأستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=27222#entry131055 برنامج فواتير منوع للأستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=26948#entry129215 برنامج حافظة شخصية دليل الهواتف للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=26211#entry124665 برنامج التقويم ( التاريخ ) للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=26155#entry124252 فاتورة للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=24322#entry113573 برنامج الفواتير كامل للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=24191#entry112811 برنامج سندات القبض والصرف للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=24191#entry112811 برنامج خبور المحاسبى برنامج كامل للأستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=17944#entry80465 برنامج خبور المحاسبى الإصدار الثالث للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=16879#entry74858 برنامج خبور الإصدار الثانى للأستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=16256#entry71834 برنامج خبور المحاسبى الإصدار الأول للأستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=15933#entry69998 برنامج حسابات للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=14978#entry65693 برنامج حسابات للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=14880#entry65142 برنامج حسابات للاستاذ / عبد الله باقشير http://www.officena.net/ib/index.php?showtopic=14619#entry63693 برنامج شراكة العقارات للاستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=49900#entry304640 برنامج الشيكات للاستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=50143#entry306916 برنامج كشوف حسابات ( منه له ) للاستاذ / أحمد زمان http://www.officena.net/ib/index.php?showtopic=50819#entry312828 معظم برامج شئون العاملين وما يتعلق بها لعديد من الأساتذة رابط تجميعى لـ محمود الشريف http://www.officena.net/ib/index.php?showtopic=51271&hl= نسخة تجريبية لنموذج شيك لـ محمود الشريف http://www.officena.net/ib/index.php?showtopic=51306#entry317305 برنامج لمتابعة أسعار الصرف ( العملات ) لـ محمود الشريف http://www.officena.net/ib/index.php?showtopic=51109#entry315286 برنامج متابعة حركة السيارات قابل للتعديل وبه امكانية متابعة الوثائق لـ / محمود الشريف http://www.officena.net/ib/index.php?showtopic=51386#entry318102 برامج ونماذج التنبيه لعديد من الأساتذة رابط تجميعى لـ محمود الشريف http://www.officena.net/ib/index.php?showtopic=51261&hl= برنامج دليل الهاتف المتطور للأستاذ / أحمد حمور http://www.officena.net/ib/index.php?showtopic=33881#entry176806 برنامج دليل الهاتف العصرى للأستاذ / أحمد حمور http://www.officena.net/ib/index.php?showtopic=34679&page=2#entry182322 برنامج دليل الهاتف على طريقة سامسونج للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=46463#entry277636 برنامج خاص لمحاسبة وجرد وصيانه الهواتف للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=48351#entry292775 برنامج تسيير الأشخاص للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=48251#entry292035 برنامج تسيير شركات النقل للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=47818#entry289335 برنامج تسيير شئون الموظفين للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=46153#entry274883 برنامج تتبع للمضيفين والآليات للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=45902#entry272143 برنامج الموردين للأستاذ / شوقى ربيع http://www.officena.net/ib/index.php?showtopic=45883#entry271941 برنامج ادارة الإيجارات الإصدار الأول للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=50382#entry309122 برنامج إدارة الخدمات المصرفية للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=51110#entry315312 برنامج إدارة الإشتراكات الشهرية للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=49929#entry304870 برنامج مستحقات نهاية الخدمة للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=47291#entry284873 برنامج سند صرف مع بيان الدفعات للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=49296#entry299662 برنامج كشف حساب للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=48492#entry293528 برنامج استمارة العائلة الإلكترونى للأستاذ / ضاحى الغريب http://www.officena.net/ib/index.php?showtopic=47555#entry287386 برامج الكنترول والمدارس لعديد من الأساتذة رابط تجميعى لـ محمود الشريف http://www.officena.net/ib/index.php?showtopic=51265&hl=

كيف تجعل قيمة حقل فى النموذج الفرعى تساوى حقلا فى الرئيسى فيديو صامت كود سطر واحد رابط ملف الشرح https://drive.google.com/file/d/0Bw4O7dVd4FBfLXlLQXNRU05sTmM/view?usp=sharing الكود فى حدث بعد التحديث للحقل فى النموذج الرئيسى Me.subf.Form.Controls("smonth") = Me.newm subf النموذج الفرعى smonth الحقل فى النموذج الفرعى newm اسم الحقل فى النموذج الرئيسى الفيديو

او اجعل كل الكود داخل if و end if اي بدون Else Private Sub ÃãÑ23_Click() On Error Resume Next If MsgBox("åá ÊÑíÏ ÝÇÊæÑÉ ÌÏíÏÉ", vbYesNo, "ÊäÈíå") = vbYes Then DoCmd.SetWarnings (warningsoff) DoCmd.RunCommand acCmdDeleteRecord [Forms]![ÝÇÊæÑÉ ÇáÔÑÇÁ]![ÊÇÈÚ15].Locked = True [Forms]![ÝÇÊæÑÉ ÇáÔÑÇÁ]![ÊÇÈÚ15].Enabled = False DoCmd.Requery End If End Sub

تحية طيبة اخي اسلام اكتب هذا الكود فقط بعد كلمة Else Exit Sub

عفوا هسه انا عم بستخدم موبايل ان شاء الله غدا ساعمل لك كما تريد اذا ما سبقني احد مع تحيات شفان ريكاني

السلام عليكم ورحمة الله تفضل اخى الكريم ادرج هذا الكود فى موديول جديد وخصص له زر فى شيت نموذج كشف المصروفات Sub Transfer() x = Range("C2").Value y = Range("C3").Value Z = Range("C4").Value A = Range("G31").Value With Sheet2 LR = .Cells(Rows.Count, "C").End(xlUp).Row + 1 .Range("B" & LR) = x .Range("C" & LR) = y .Range("D" & LR) = Z .Range("E" & LR) = A End With End Sub

السلام عليكم ضع هذا السطر مكان السطر الذي يحتوي على الخطأ Me.TextBox1 = Format(cl.Offset(0, 3), "yyyy/mm/dd")

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

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

الحمد لله اخوي ابو جودي توصلت لحل المشكلة ولم تكن مشاركة مجلد الصور كان حجم حقل المسار في الجدول 50 .... وخليته 200 وانحلت ولم اشارك مجلد الصور .. فقط وضعته في مجلد المشاركة للبرنامج والأمور تمام

ومن هنا نافذة اخرى http://arabteam2000-forum.com/index.php?/topic/29557-حل-مشكلة-طلب-التاريخ-والوقت-من-الا-سكيو-ال-سيرفر/

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

شوف استعلام 2 ونموذج asmend في البداية فتح نموذج الرئيسية اتمنى ان تنال اعجابك مع تقدير شفان ريكاني PSDB - Copy.rar

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة كود ادراج صف بدبل كليك مع نسخ معادلات تم ارفاق كود الحل من الفاضل _ أ / أبوعبد الله مرفق الملف فك حماية الشيت 123 sayed1.rar و لا تنسونا من صالح الدعاء

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

الامر هين اخي العزيز في جدول (سجل) احذف حقل (تأريخ انتهاء التوقيف) ثم انشئ حقل جديد بنفس الاسم ولكن اختار نوع البيانات (محسوب) ثم ضع التعبير التالي DateSerial(Year([تاريخ التوقيف]);Month([تاريخ التوقيف]);Day([تاريخ التوقيف])+[مدة التوقيف])

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

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

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة اخفاء عامود طالما كل الخلايا = صفر او فاضية تم ارفاق كود الحل من الفاضل _ أ / أيسم إبراهيم يوم 25 aysam).rar _ أ / ياسر خليل أبو البراء Baraa (hide zero column).rar _ أ / أبوعبد الله إخفاء الأعمدة الخالية عند الطباعة (1).rar و لا تنسونا من صالح الدعاء

السلام عليكم من رخصة الاستاذ شيفان تفضل اخي العزيز سجلات المرور.rar

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

الأخ الكريمalmshtag السلام عليكم يرجى اتباع تعليمات المنتدى بتغيير الأسم الى اللغة العربية وبعد اذن اخى العزيز @سليم حاصبيا وتبسيطاً للموضوع Sub abo_abary() For i = 2 To [g2] + 1 [c2] = [c2] & " " & Range("a" & i) Next End Sub abo_abary_1111.zip

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

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

اسال الله تعالى ان تكون وجدت ضالتك ☺

الإجابة: Dim i As Integer i = 0 Do i = i + 1 Loop Until Cells(i, 1).Value = "" MsgBox "Cell A" & i & " is blank!" لاحظ بأن until كُتبت بعد Loop ، وهذا طريقة أخرى للترتيب، وقد استخدمت لأن الشرط يعتمد على نتيجة خلية. وهذه طريقة أخرى اعتمدت على شرط أنه إذا كانت الخلية فارغة فأعطها true Dim BlankFound As Boolean Dim x As Long 'Loop until a blank cell is found in Column A Do Until BlankFound = True x = x + 1 If Cells(x, "A").Value = "" Then BlankFound = True End If Loop 'Report out first blank cell found in Column A MsgBox "Cell A" & x & " is blank!" إلى هنا انتهت الحلقة الثانية ودمتم سالمين وهذا هو الملف المرفق first_blank.rar

السلام عليكم ورحمة الله معذرة على هذا الخلل، لم أتمم وضع كل المعادلات اللازمة في الجدول... وقد تم التعديل في الملف المرفق... راقب كل النتائج المستدعاة وردّ علي في حالة وجود أخطاء مع تحديدها... بن علية summary_2.rar

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

وجزيت خيراً معلمي بمثل ما دعوت لي .. ويبقى لك الفضل بعد الله عزوجل في أني أحببت هذا المجال تقبل وافر تقديري واحترامي

اخي ابو البراء جزاك الله خيرا اليوم تعلمت منك ProtectScenarios و استفدت منها

2- الدالة Do until loop الغرض من ذلك هو تكرار مجموعة معينة من البيانات إلى أن يتم يتحقق الشرط فعندها يتم إنهاء الحلقة التكرارية. فمثلاً لو طُلب منك بأن تكتب أرقام متسلسلة في العمود الأول وتضع شرطاً بأن يتوقف عندما يكون الرقم يساوي 11، فعندها سيكون الكود كالتالي : i = 1 Do Until i = 11 Cells(i, 1) = i i = i + 1 Loop لاحظ بأنه عندما تكون قيمة i = 11 فإنه يتوقف عن العمل ولا يكتب قيمتها.. شاهد المرفق لتعرف آلية العمل do_until_01.rar طيب .. ماذا يفرق لدينا لو استخدمنا i>11 ؟!!! i = 1 Do Until i > 11 Cells(i, 1) = i i = i + 1 Loop فهل ستكون النتيجة مختلفة؟!!!

ببساطة نضيف حلقة تكرارية أخرى على الدرس السابق لتصبح كالتالي Dim i As Integer Dim j As Integer For j = 1 To 2 For i = 1 To 100 Cells(i, j).Value = i Next i Next j لاحظ أننا عرفنا الحلقة التكرارية j والتي تساوي 2 وهي عدد الأعمدة المطلوب تطبيق الكود عليها ، ولا تنسى بأن تغلق الحلقة التكرارية ب Next ، جرب أن تغير عدد الأعمدة في المرفق التالي. الحلقة التكرارية2.rar سؤالنا التالي: كيف أكرر الكود السابق على ثلاث شيتات؟

عوداً حميداً أخي وحبيبي إبراهيم .. أين كنت يا رجل ؟ أما افتقدت إخوانك!! شوف الرابط ده فيه شرح لكود أخونا العربي http://yasserkhalilexcellover.blogspot.com.eg/2016/10/search-using-arrays.html

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

السلام عليكم للاحتراف : عليك بــ 2003 يدعم صلاحيات المستخدمين وصفحات النت والا فاخرج من اكسس واستخدم ستوديو دوت نت كان زمان الواحد يتردد على المنتدى شهر شهرين ويصبح خبير اكسس وبعد الاصدارات الحديثة الواحد يتردد سنين ولا يحصل شي السبب لانها تصنع له معظم الخطوات

السلام عليكم اخ سلمان .. تفضل هذا رابط تحميل اكسس ران تايم 2016 https://www.microsoft.com/en-us/download/details.aspx?id=50040 وهذا رابط تحميل اكسس ران تايم 2013 https://www.microsoft.com/en-us/download/details.aspx?id=39358 وهذا رابط تحميل اكسس ران تايم 2010 https://www.microsoft.com/en-us/download/details.aspx?id=10910 وهذا رابط تحميل اكسس ران تايم 2007 https://www.microsoft.com/en-us/download/details.aspx?id=4438 تحياتى

السلام عليكم اعادة تسمية للامتداد تكفي اخي محمد سلامة ويمكنك وضع هذا الكود في النموذج الافتتاحي لتقوم باخفاء شريط اكسس والتأكد ان الامتداد صحيح وانه accdr DoCmd.ShowToolbar "ribbon", acToolbarNo Dim a As String a = Right(Me.Application.CurrentProject.FullName, 5) If a = "accdr" Then Else MsgBox "تم تغيير امتداد البرنامج ولا يمكن ان يعمل البرنامج بشكل صحيح إلا بعد إعادة الامتداد كما كان" DoCmd.Quit acQuitSaveAll End If

أخي الكريم هاني يرجى وضع الأكواد بين أقواس الكود ليظهر بشكل منضبط جرب الكود التالي عله يفي بالغرض .. قبل تنفيذ الكود حدد الخلايا المراد حمايتها ثم كليك يمين ثم Format Cells ثم انتقل للتبويب Protection ثم علم علامة صح بحوار الخيار Locked Sub Protect_All_Sheets() Dim Sh As Worksheet For Each Sh In Worksheets If Sh.ProtectScenarios = False Then Sh.Protect "aaaa" Sh.EnableSelection = xlUnlockedCells End If Next Sh End Sub تقبل تحياتي