۩◊۩ أبو حنين ۩◊۩

السلام عليكم اخى الحبيب شوقى اعتزر لك على كثره طلبات اخى الحبييب الكود عن تشغيله لا يعمل ولا يؤثر على اى شئ وتم اضافىة Option Explicit الا الكود لا يضيف اى شئ فما الخطاء

اخى الحبيب شوقى اسم الكود غير مكرر وضمان لذلك عيرت اسم الكود نهائى اكثر من مره والنتيجة اللون الاصفر Sub add() اخى الحبيب هل يمكن تطبيق الكود على الملف المرفق جزاك الله خيرا ترقية المستخدم.rar

وَلاَ تُرْجِ فِعْلَ الصَّالِحَاتِ إِلَى غَدٍ لَعَلَّ غَدًا يَأْتِي وَأَنْتَ فَقِيدُ الله ... سلمكت يداك وجزاك الله خيرا على التذكرة

السلام عليكم عند تنفيز الكود يعطى لون اصفر على اسم الكود Sub addition_1() هل ممن الننكن تنفيزة على الملرفق جزاك الله كلالخير

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

السلام عليكم الاخوة الافاضل اعلم انى اثقل عليكم واعلم مدى انشغالكم فتقبلوا عزرى الكود المراد هو كود Sub addition اسم المستخدم الدعم الفنى كلمه المرور 111 المراد ان يعمل الكود عند الضغط على الزر على السيتات الاتىى اسمائها مره واحده الادارية الاتصالات الغاز المعمل الطبية الهندسية الامن الصتاعى المهمات الانتاج المعالجة الصيانة جزاكم الله كل الخير على تقديم المساعده ترقية المستخدم.rar

للرفع

أخى الجليل / عمــــاد الحســـامى السلام عليكم جزاك الله حيرا على عطائك سلمت يداك..

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

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

السلام عليكم الاخ العزيز سليم اوى جزاك الله كل الخير ثانيا بعتزر لعدم ايصال المطلوب بوضوح الكود المرفق يعمل على ActiveSheet الذى اريده ان استبدل ActiveSheet باكثر من شيت يتم ادخالهم لكى يعمل الشيت على الشيتات التى اضفهل له مره واحده بدلا من كونى ادخل كل صفحه واقوم بتفعيل الكود الكود يعمل بصوره جيده الا انى اريد استبدال ActiveSheet بالشيتات التى اريدها مثل الاداريه و الاتصالات والمعل و الهندسيه والصيانه والطبيه ارجو ان تكون الصوره واضحه جزاك الله خيرا على اهتمامك .Sub addition_1() Dim ER, R ER = ActiveSheet.UsedRange.Rows.Count For R = 8 To ER If WorksheetFunction.IsNumber(Cells(R, 7)) = True And _ Cells(R, 7) <> 0 Then Cells(R, 7) = Cells(R, 7) + 1 If WorksheetFunction.IsNumber(Cells(R, 21)) = True And _ Cells(R, 21) <> 0 Then Cells(R, 21) = Cells(R, 21) + 1 Next R End Sub

السلام عليكم الاخ سليم حاصبيا الكود لا يعمل اذ انه يعطى لون احمد على السطرين Sub add_one lr = Cells(Rows.Count, 7).End(xlUp).Row For r = 8 To lr ((y = Application.WorksheetFunction.IsNumber(Cells(7, 7 ((y1 = Application.WorksheetFunction.IsNumber(Cells(21, 7 لا اعلم لماذا وبعد تعديل الكود بهذا الشكل لا يعمل لا اجد اى تغير Sub add_one() lr = Cells(Rows.Count, 7).End(xlUp).Row For R = 8 To lr y = Application.WorksheetFunction.IsNumber(Cells(7, 7)) y1 = Application.WorksheetFunction.IsNumber(Cells(21, 7)) If y And y1 And Cells(lr, 7) > 0 _ And Cells(lr, 21) > 0 Then Cells(lr, 7) = Cells(lr, 7) + 1: Cells(lr, 21) = Cells(lr, 21) + 1 End If Next End Sub

السلام عليكم الساده الكرام ... اكرمك الله بفضله ارجو المساعده فى تصحيح ذلك الكود هذا الكود يعمل على اضافه واحد للخلايا الموضحه Sub addition_1() Dim ER, R ER = ActiveSheet.UsedRange.Rows.Count For R = 8 To ER If WorksheetFunction.IsNumber(Cells(R, 7)) = True And _ Cells(R, 7) <> 0 Then Cells(R, 7) = Cells(R, 7) + 1 If WorksheetFunction.IsNumber(Cells(R, 21)) = True And _ Cells(R, 21) <> 0 Then Cells(R, 21) = Cells(R, 21) + 1 Next R End Sub اريد ان اضيف اكثر من شيت بدلا من ActiveSheet وليكن شيت الادارية والاتصالات والمعمل وهكذا لكى يعمل الكود مره واحده على جميع الشيتات المذكرة جزاك الله خيرا

السلام عليكم فعلا ... شكر لله ان وفق الساده القائمين علىى المنتدى والاعضاء ... للتواجد فى ذلك الصرح شكر ... واجب لجميع الساده الافاضل جميعا دون ذكر اسماء حتى لا نغفل عن ذكر احمد شكر ... واجب مستحق للمجهود فى مساعده الاخرين شكر ... واجب على الوقت والمعلومه شكر ... واجب على التعليم المستمر من جميع القائمين واعضاء المنتدى بارك الله فيهم أجمعين وأسأل رب العالمين لهم أن يحفظكم من كل سوء

السلام عليكم الاخت الفاضلة ام عبد الله جزاكى الله خيرا

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

السلام عليكم الاخ الفاضل إبراهيم محمد جزاك الله خيرا على مجهودك الرائع وتبقى ملاحظه غايه فى الاهميه انه من خلال اى مستخدم يمكن تغير الصلاحيات لاى مستخدم اخر من خلال استدعاء Sub Show_F2 وذلك الاستدعاء يعتبر ثعرة اذ يمكن تعديل صلاحيات جميع المستخدمين حتى الدعم الفنى كيف يمكن التغلب عليها ... وجعل الدعم الفنى هو من له صلاحيه استعداء تلك الفرمة فقط وتم عرض الموضوع فى المنتدى http://www.officena.net/ib/index.php?showtopic=53940 ولم اتوصل لحل حتى الان ارجو حل تلك المشكله

السلام عليكم السادة الافاضل ... الاخوة الاعزاء هل يمكن اختصار استدعاء فرمة تغير صلاحيات المستخدمين على مستحدم محدد لان الاستدعاء ظاهر فى macros ومن هنا يمكن لاى مستخدم استدعاء فرمة تغير الصلاحيات هل يمكن اختصار ذلك الكود على مستتخدم محدد Sub Show_F2() UserForm2.Show End Sub

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

للرفع

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

الرجاء النظر فى المرفق فى المشاركة رقم 6 عند علف الملف يحدث خطاء اين الخطاء

السلام عليكم برنامج اكثر من رائع وهل يمكن اضافه كود لتفعيل خفض درجه الامان جزاك الله خيرا

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

السلام عليكم الاخوة الافاضل لماذا يظهر الخطاء فى ذلك الكود الحطاء بالون الاحمر Private Sub Workbook_Open() Sheets("MyDate").Range("E3:IT3").ClearContents For I = 2 To Sheets.Count Sheets("MyDate").Cells(3, I + 3) = Sheets(I).Name Next 'UserForm1.Show End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("moving").Activate Application.ScreenUpdating = False For I = 2 To Sheets.Count (Sheets(I).Unprotect (5240 Next Application.ScreenUpdating = True End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Cancel = True If SaveAsUI = True Then Me.Save Cancel = True End If End Sub