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

وعليكم السلام-كان عليك لزاما قبل رفع المشاركة استخدام خاصية البحث فى المنتدى ,فقد تكرر هذا الموضوع مرات عديدة ومنها : https://www.officena.net/ib/topic/94016-دالة-استخراج-تاريخ-الميلاد-والنوع-والمحافظة-من-الرقم-القومي/?tab=comments#comment-583042

تفضل Final Indeminity1.xlsx

تفضل قائمة 1منسدله.xls

أحسنت استاذ محمد بارك الله فيك وجعله الله فى ميزان حسناتك

وعليكم السلام-تفضل Test vlookup1.xlsx

وعليكم السلام -تفضل استاذنا الكريم ياسر خليل ابو البراء على تناول هذا الموضوع من قبل اعتذر منك استاذى الكريم ياسر فليس هناك امكانية فى وضع الرابط هنا ولكن تم وضعه داخل الملف لكى تعم الإستفادة للجميع للإطلاع على هذا الموضوع والإستفادة منه ان شاء الله حماية المعادلات في كل أوراق العمل Protect Formulas In All Sheets.xlsm

أحسنت استاذ مجدى عمل رائع جعله الله فى ميزان حسناتك

أحسنت استاذ مجدى بارك الله فيك

اتفضل اخي الكريم Dim Rs, RsFile As Recordset Set Rs = CurrentDb.OpenRecordset("اسم الجدول") Rs.MoveFirst Do While Not Rs.EOF If IsNull(DLookup("ID_User", "Users", "ID_User='" & [ID_User] & "'")) Then Rs![ID_User] = [ID_User] Rs![ID_Group] = [ID_Group] Rs![IAM] = [IAM] Rs![BIRTHDATE] = [BIRTHDATE] Rs![Email] = [Email] Rs![PHONE] = [PHONE] Rs![ImagePath] = [ImagePath] Else If Rs![ID_User] = [ID_User] Then Rs.Edit Rs![ID_Group] = [ID_Group] Rs![IAM] = [IAM] Rs![BIRTHDATE] = [BIRTHDATE] Rs![Email] = [Email] Rs![PHONE] = [PHONE] Rs![ImagePath] = [ImagePath] Rs.Update End If End If Rs.Update Rs.MoveNext Loop Rs.Close

طيب حضرتك اتفضل جرب Prog302.mdb

طريقة اخرى Count Down WaitSeconds.accdb

فورم حذف البيانات المسجلة فيديو9 الفيديو

جرب المرفق ترحيل خلايا محددة لاخري محددة في شيتات مختلفة.xlsm

شرح كيفية عمل شاشة دخول للاكسل بصورة جمالية الفيديو

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

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

السلام عليكم اولا للعلم لا يوجد شئ اسمه حماية مطلقة فدائما الحماية هى مسئلة نسبية ومسأله وقت لذلك نصيحتى ولوجه الله لا تشغل بالك كثيرا بهذا الموضوع كما انصحك نصيحة أخرى ان وجود الازرار فى الواجهة والتى تحمل اسم Management , Admin وخاصة عند الضغط عليها وطلب كلمة المرور فإنها حتما سوف تثير فضول المتطفلين فى محاولات شتى انت فى غنى عنها ممكن بشكل أو بأخر تنفيذ ما تريد بدون ان تقدم للعابثين ما يثير فضولهم

اتفضل 120 (1).accdb

سبحان الله هذا رزقك خطرت على بالى فكرة ونجحت اتفضل Count Down WaitSeconds.accdb

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

أحسنت استاذ مجدى بارك الله فيك

بارك الله فيك وزادك الله من فضله

كان فيه خطا في المرفق السابق حمل التعديل Prog302 (1)2.mdb

اخي و حبيبي @ابا جودى انت معلمنا و استاذنا الفاضل تأمر علينا و نحن ننفذ حبا لك مرفق التعديل مثال للتعامل مع الصور (1).mdb

اتفضل ان شاء الله تجد ضالتك Prog302 (1).mdb

بسيطة يا سيدى انتظرنى

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

هو واضح ان المعيار السابق فيه خطا لانه اكبر او يساوي +1 لابد يحصل فارق رقم طالما العدد فردي وانا جربت وعدلت المعيار واشتغل تمام غلطت @ابا جودى بالف

فكرة جميلة

اتفضل للعلم لا ادرى ان كانت هناك حلول برمجية ام لا ما اقدمه اليك مجرد حيلة وتحايل ليس إلا Database6 (2).accdb

بارك الله فيك وجزاك الله خير اباجودي اداه مهمة جدا لكل مبرمج الف شكر وفقك الله ونفع بك

صباح النور وعطور الزهور على معلمى الجليل استاذى الكريم الفاضل الاستاذ @essam rabea صاحى اصلى وما جالى نوم دخلت للمنتدى جزاكم الله خيرا استاذى الجليل على دعواتكم الطيبة أوووف والله لم انتبه اسف جدا جدا حاضر استاذى لن أشارك كثيرا بعد ذلك سانتظر ليكون ردى بعد اساتذتى ان تفضل الله تعالى بأفكار مختلفة من الان كل الزبائن لكم ولكن سوف اقتسم معكم الاجر

الشكر الموصول لك اخي العزيز العيدروس اللهم زدك علما وبارك لك في عملك ورزقك على مابذلته في مساعدتي

علكم السلام هذه تجربة متواضعة يمكنك العمل عليها ان اعجبتك التنقل بين الصفحات.xlsm

هذا رزقي وابداعك استاذي ابا جودي شكرا كتير الك

اتفضل فتح نموذج اكثر من مرة.accdb

اخي العزيز من بعد اذن الادم واعضاء الكرام اذهب الى الوحدات النمطية وانشأ وحدة جديدة module وانسخ هذا الكود Function ap_DisableSift() On Error GoTo errdisableshift ' ÊÚØíá ãÝÊÇÍ ÇáÔÝÊ Dim DB As dao.Database Dim prop As dao.Property Const ConPropNotFound = 3270 Set DB = CurrentDb() DB.Properties("AllowByPasskey") = False Exit Function errdisableshift: If Err = ConPropNotFound Then Set prop = DB.CreateProperty("AllowByPasskey", _ dbBoolean, False) DB.Properties.Append prop Resume Next Else MsgBox "ÚãáíÉ ÊÚØíá ãÝÊÇÍ ÇáÏÎæá Çáì ÇáäÙÇã áã ÊßÊãá ÈäÌÇÍ" Exit Function End If End Function Function ap_EnableSift() On Error GoTo errdisableshift ' ÇÊÇÍÉ ãÝÊÇÍ ÇáÔÝÊ Dim DB As dao.Database Dim prop As dao.Property Const ConPropNotFound = 3270 Set DB = CurrentDb() DB.Properties("AllowByPasskey") = True Exit Function errdisableshift: If Err = ConPropNotFound Then Set prop = DB.CreateProperty("AllowByPasskey", _ dbBoolean, True) DB.Properties.Append prop Resume Next Else MsgBox "ÚãáíÉ ÊÚØíá ãÝÊÇÍ ÇáÏÎæá Çáì ÇáäÙÇã áã ÊßÊãá ÈäÌÇÍ" Exit Function End If End Function Private Sub Label16_Click() ap_DisableSift End Sub Private Sub Label16_DblClick(Cancel As Integer) ap_EnableSift End Sub ثم اذهب الى النموذج الرئيسي واصنع مربع نص واكتب به اي شي ليس مهم واذهب الى خيارات المربع في الحدث عند نقر لمرة واحدة ضع هذا الكود ap_DisableSift وعند نقر مزدوج ضع هذا الكود ap_EnableSift اي عند النقر لمرة واحد على مربع النص يقفل الشفت وعند النقر المزدوج يفتح الشفت ارجو ان تكون وصلت الفكرة

بعد اذن اخي علي قائمة منسدله 1.xls

سلام تم اضافة رسالة عند ترك حقول فارغة ولايمكن الحفظ او الطباعة الابعد استكمال كافة الحقول تم وضع كلمة مرور على عرض التصميم نفس كلمة المرور السابقة ولايمكن فتح التصميم الا في حالة عدم وجود سجل مفتوح في النموذج بخصوص الحماية في اكسس نسبية ولكن ابحث في الموقع عن الغاء الشفت التصميم جميل بارك الله فيك اخيرا البرنامج يحتاج الى بعض المراجعة للاكواد وووو لكن كل واحد ادري باحتياجة ولكل واحد طريقة عمله تقبل تحياتي HCT Permit To Work System - Copy.mdb

احسنت اخي ابو عارف بارك الله فيك

تم ياباشا شوف المرفق Database41.accdb

وعليكم السلام بارك الله فيكم وزادكم الله من فضله

تم التعديل على الملف السابق بتعميم المعادلة لكى تعمل على كل الأعمدة وهذه هى المعادلة =COUNTIF(D$7:D7,D7)>1

شاهذ هذا الفيديو https://www.youtube.com/watch?v=SQHJuc-AdAM

جرب هذا الملف الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$H$1" And Target.Count = 1 Then sort_please End If Application.EnableEvents = True End Sub '========================= Sub sort_please() Dim Rg As Range Dim s Dim ro%: ro = Range("b2", Range("b1").End(4)).Rows.Count + 1 Set Rg = Range("a1").Resize(ro, 3) Rg.Sort key1:=Cells(1, Range("h1")), _ Order1:=IIf(Range("h1") = 2, 2, 1), Header:=2 s = "Row( 1:" & ro & ")" Range("a1").Resize(ro) = Evaluate(s) End Sub الملف مرفق 0Choose_Num_sort.xlsm

بارك الله فيك وزادك الله من فضله

جرب هذا الماكرو Option Explicit Private Fltr_range As Range, I_range As Range Private EHsaa As Worksheet, Tasj As Worksheet Private lr_EHsaa%, lr_Tasj, m% '=============================== Sub my_filter() Set EHsaa = Sheets("احصاء الغيابات") Set Tasj = Sheets("تسجيل الغيابات") lr_EHsaa = EHsaa.Cells(Rows.Count, 2).End(3).Row lr_Tasj = Tasj.Cells(Rows.Count, 2).End(3).Row Set Fltr_range = Tasj.Range("B6:E" & lr_Tasj) Set I_range = EHsaa.Range("T1:T6") lr_EHsaa = IIf(lr_EHsaa = 3, 4, lr_EHsaa + 1) Dim i% For i = 1 To I_range.Rows.Count Call Filter_FOR_Me(Fltr_range, 3, EHsaa.Range("T" & i)) Next EHsaa.Range("b3").Select Application.CutCopyMode = False Fltr_range.AutoFilter End Sub '============================================= Sub Filter_FOR_Me(rg As Range, n, St) rg.AutoFilter , field:=n, Criteria1:=St rg.Offset(1).Resize(rg.Rows.Count - 1).Copy EHsaa.Range("B" & lr_EHsaa).PasteSpecial xlValues m = EHsaa.Cells(Rows.Count, 2).End(3).Row + 1 lr_EHsaa = m + 1 End Sub الملف مرفق Abscence.xlsm

تفضل لك ما طلبت تنسيق شرطى بشرطين.xlsx

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

تفضل لك ما طلبت وزيادة تم عمل كود ووضعه في حدث الصفحة لحماية الصفحة الرئيسية _ وكلمة السر 123 Private Sub Worksheet_Activate() Sheets("Main").Protect Password:="123", UserInterFaceOnly:=True End Sub Book1.xlsm