صلاح الصغير

up

فعلا حاجة غريبة انا عطلت كل الاكواد و عطلت الماكرو و اوراق العمل لم تظهر

فعلا ا / ياسر عندك حق عموما يا باشا خد راحتك ده كودك و انت حر فيه بس انا و الله ما لعبت فى حاجة كل الموضوع يمكن يفيدكم فى حاجة انى حفظت الملف الاصلى الى امتداد binary لتقليل حجم الملف

ا / ياسر هذا هوا الملف مرة اخرى و به الكود الخاص بك فقط اما عن الباسوورد فهى تظهر اليا فى حالة تفعيل الماكرو و فى حالة عدم تفعيله يظهر الاكسل بالشكل الموجود فى المشاركة السابقة و اذا شلته هنجرب ازاى الكود يوزر : صلاح باس : 24229197 salah 2016.rar

ا / ياسر تم العثور على هذه الصفحة هل هذا معناه ان النسخة غير مشتراه و جارى تنزيل نسخة اخرى بتحديثات مايو https://support.office.com/ar-sa/article/دالة-TEXTJOIN-357b449a-ec91-49d0-80c3-0e8fc845691c و هذا هو رابط النسخة الجديدة http://filecloud.io/wzn01u48s اقوم الان بتنزيلها

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

للاسف لم يحدث شيئا

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

اكيد

اليوزر : صلاح الباس : 24229197 ملاحظة الكودين موجودين و معطل الكود الاصلى salah 2016.rar

للاسف لا

تم تحديث الاوفيس

شكرا ا ياسر على الملاحظة اليك الملف extract nom.rar

شكرا ا / ياسر تم نسخ الكود و لكن هناك خطا فى هذا السطر تم اضافة ورقة باسم warning و تم تدارك الخطأ و لكن لا يتم تفعيل السطرين المدمجين اى ان الاكسيل لا يراهم و يعمل الكود كما هو على قديمه يعنى

هذا كود خلاصة مساعدة الاساتذة الكرام و اخص بالذكر الاستاذ / ياسر خليل Private Sub Workbook_Open() Application.Visible = False kh_AhlnWShln End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim MyFilePath$, Extension$ MyFilePath = "d:\حسابات\مراجعة\" Extension = Left(ThisWorkbook.Name, Len _ (ThisWorkbook.Name) - 4) & " Backup" On Error Resume Next '<< folder exists MkDir MyFilePath & Extension '<< create folder 'save current version of this book in the folder ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & _ Extension & "\" & Extension & _ (Format(Now, " yyyy mm dd, hh.mm.ss AMPM")) & ".xlsm" End Sub Public Function MyPCpath$(Folder) MyPCpath = CreateObject("WScript.Shell").SpecialFolders _ (Folder) & Application.PathSeparator End Function و الفكرة الاساسية هى الكود الاول و هو يقوم بغلق الاكسيل فى حالة عدم تفعيل الماكرو و اظهار صفحة خالية وفى حالى تفعيل الماكرو يقوم باستدعاء شاشة الدخول اى تأمين 100 % و هذا هو كود الاستاذ / ياسر و الذى يعمل على اخفاء الاوراق و اظهار ورقة بها رسالة بضرورة تفعيل الماكرو 'يوضع الكود في حدث المصنف ويقوم بإخفاء كل أوراق العمل في حالة عدم تمكين الماكرو 'أي أنه يجبر المستخدم على تفعيل الماكرو لإظهار أوراق العمل ، أما في حالة إذا ما 'كان الماكرو مفعل ، فإن ورقة العمل التحذيرية تختفي وتظهر بقية أوراق العمل '------------------------------------------------------------------------------- 'قم بتعيين اسم ورقة العمل التحذيرية Const Warning As String = "Warning" Private Sub Workbook_Open() Dim Ws As Worksheet Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets Ws.Visible = xlSheetVisible Next Ws Sheets(Warning).Visible = xlVeryHidden Application.ScreenUpdating = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Ws As Worksheet Application.ScreenUpdating = False Sheets(Warning).Visible = xlSheetVisible For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> Warning Then Ws.Visible = xlVeryHidden End If Next Ws Application.ScreenUpdating = True ActiveWorkbook.Save End Sub و المراد ادماج الكودين فقط فى الجزئية الخاصة بالاستاذ / ياسر و شكرا

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

لماذا لا تعمل المعادلة مع ان عندى اوفيس 2016 و شكرااااااا

جرب حضرتك ادراج صفوف قبل الصفوف الهيد سوع يعطيك رسالة خطا

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

شكرا للاساتذة الافاضل سرعة الاستجابة هى العادة دائما تم الحل ايضا من خلال هذا الكود ممكن اعرف الفرق و الافضل Sub unfilter() Dim Sh As Worksheet For Each Sh In Sheets Sh.AutoFilterMode = False Sh.Range("a1:c5000").AutoFilter Next Sh End Sub شكرا عرفت الفرق بعد تجربة الثلاثة اكواد و هو فى الكود الثانى عدم الارتباط باعمدة معينة

السلام عليكم .... اريد كود لعمل عدم تصفية على عمود معين فى كل الاوراق و ليكن فى اول ورقة او حدث الورقة عند فتحه.....و شكرا unfilter all sheets.rar

تجربة ناجحة تمام ا / ياسر

ا / ياسر اشكرك اولا على الاستجابة ثانيا باي وورد الملف هو من ابداعاتكم و ليس من عندى و الله ما اعرف اشيله ازاى ثالثا بالنسبة لمحرر الاكواد ان كتبته و ذلك للاستفادة من الاكواد فى الملف رابع مش عارف اوضح اكتر من المشاركة الاولى و مع ذلك احاول افسر اكتر الملف عبارة عن مستحقات موظفين عن سنة ميلادية كاملة مرتبة من شهر 1 : 12 المعادلة فى الاعمدة dr dq dp لها شقين 1 اذا كان الشهر فى العمود a6 =1 فيتم تنفيذ معادلة معينة الا وهى مثلا فى الخلية dp يتم جمع الخلية cd للكود و هو مجموع التأمينات اما و ان كانت الخلية a6 لا تساوى 1 فذلك معناه ان احنا فى الشهر الثانى لهذا الكود و تم عمل مكافات للكود فى مكافاة 1 و 2 و 3 الى اخره حتى مكافاة 10 فيتم استدعاء اخر مجموع للتأمينات فى الخلية kn و ذلك للجمع عليها و عدم تخطى الكود الحد الاقصى للاجر المتغير و هكذا و السؤال هنا السنى مرتبة ميلادية و هذا معناه ترتيب تصاعدى من 1 : 12 و المعادلة فى الشق الثانى تقول ان اذا كانت a6 لا تساوى 1 فقم باستدعاء اخر مجموع من التامينات حسب الشهر الحالى -1 اى اذا كان الشهر 8 مثلا فيتم استدعاء اخر مجموع تامينات فى شهر 7 فى العمود kn و ذلك منطقى لان السنة الميلادية تصاعدية ام السنة المالية فى غير ذلك فهى تبدأ من 7 و تنهى فى 6 كما تعلم اى 7 8 9 10 11 12 1 2 3 4 5 6 و السؤال هنا ان المعادلة فى شقها الاول سوف تكون اذا كان الشهر = 7 ماشى تمام و ذلك حتى شهر 12 و لكن من شهر 1 كيف يتم استدعاء تامينات شهر 12 لان المعادلة سوف يكون نتيجتها فى هذا ااشهر 1 - 1 = 0 ارجو ان اكون اوضحت اكثر و عذرا شديدا للاطالة

السلام عليكم و رحمة الله و بركاته تحياتى للاستاذ / ياسر خليل و الاستاذ / سليم حاصبيا و الاستاذ/ رجب جاويس و الاستاذ/ ابراهيم ابو ليلة و عذرا ان كنت نسيت احد

ارجو ان يكون الشرح وافى