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

السلام عليكم ورحمة الله وبركاته قبل عامين تقريباً كنت قد بدأت بتصميم برنامج إدارة و حضور وانصراف لنادي رياضي أو لياقة بدنية . واليوم سأطرح البرنامج مع بعض التعديلات البسيطة التي جرت عليه كهدية وتجربة قابلة للتطوير والتحديث ومفتوح المصدر . Password : admin GYM 2022 - Final.zip الدعاء لوالدي رحمه الله ، ولوالدتي بالشفاء التام

واديك انكشفت يا حلو

الشرح والمرفق اولا سوف استخدم نموذج غير منضم لادراج البيانات الى الجدول وسوف اقوم بعمل وحدة نمطية واقوم بإضافة الكود الاتى Public Function ClearControls(ByRef Frm As Access.Form) On Error GoTo errClear Dim ctr As Access.Control For Each ctr In Frm.Controls If ctr.Tag = "ctrClear" Then ctr.Value = Null Next ctr Exit Function errClear: MsgBox Err.Number & " " & Err.Description & " in Clear Controls" Resume Next End Function وظيفة الكود الدوران على جميع عناصر التحكم فى النموذج ليقوم بتغيير القيم الى Null وطبعا لانى لو اردت استخدامه على عناصر محدده دون أخرى أو استخدامه فى نماذج اخرى منضمه لن أحدد نوع عناصر التحكم فى الكود ولكن سوف استخدم وظيفة التاج على عناصر التحكم يعنى سوف يقوم الكود بالدوران على جميع عناصر التحكم فى النموذج ليغير قيمها الى Null عند تحقق الشرط وجود كلمة ctrClear فى خاصية التاج على عناصر التحكم مثل الصورة الاتية طبعا يتم استخدام هذا الكود باستدعاءه عند الضغط على زر جديد كالتالى Call ClearControls(Me) والان عند الضغط على زرحفظ نريد منه عند تحقق الشرط بعدم وجود تسجيل لنفس الموظف فى دورة جديدة فى حالة تسجيل نفس الموظف فى دورة أخرى ضمن تاريخ انعقاد الدورتان اى لابد ان تنتهى أى دروة سابقة وكذلك لن يمكن تسجيل تاريخ اقل من أو يساوى تاريخ اى دورة انتهت يكون الكود بالشكل الاتى عند التحقق من التاريخ لو النتيجة المطلوبة صحيحه يتم حفظ البيانات فى الجدول من خلال اضافة البيانات عن طريف الـ Recordset Dim db As DAO.Database: Dim rs As DAO.Recordset: Dim strMsg As String: Dim strTitle As String Dim dtmMaxStartDate As Date: Dim dtmMaxEndDate As Date: Dim dtmNewDate As Date dtmNewDate = Me.txtCstart dtmMaxStartDate = DMax("[Cstart]", "courses", "[num] =" & Me.txtNo) dtmMaxEndDate = DMax("[Cend]", "courses", "[num] =" & Me.txtNo) strMsg = ChrW(32) & ChrW(1607) & ChrW(1606) & ChrW(1575) & ChrW(1603) & ChrW(32) & ChrW(1583) & ChrW(1608) & ChrW(1585) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(1593) & _ ChrW(1602) & ChrW(1583) & ChrW(1577) & ChrW(32) & ChrW(1576) & ChrW(1575) & ChrW(1604) & ChrW(1601) & ChrW(1593) & ChrW(1604) & ChrW(32) & ChrW(1601) & ChrW(1609) & _ ChrW(32) & ChrW(1606) & ChrW(1591) & ChrW(1575) & ChrW(1602) & ChrW(32) & ChrW(1578) & ChrW(1575) & ChrW(1585) & ChrW(1610) & ChrW(1582) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1583) & ChrW(1608) & ChrW(1585) & ChrW(1577) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1580) & ChrW(1583) & ChrW(1610) & ChrW(1583) & ChrW(1577) & _ ChrW(32) & ChrW(1604) & ChrW(1607) & ChrW(1584) & ChrW(1575) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & ChrW(1608) & ChrW(1592) & ChrW(1601) & ChrW(13) & _ ChrW(10) & ChrW(1604) & ChrW(1606) & ChrW(32) & ChrW(1610) & ChrW(1578) & ChrW(1605) & ChrW(32) & ChrW(1578) & ChrW(1587) & ChrW(1580) & ChrW(1610) & ChrW(1604) & _ ChrW(32) & ChrW(1576) & ChrW(1610) & ChrW(1575) & ChrW(1606) & ChrW(1575) & ChrW(1578) & ChrW(32) & ChrW(1607) & ChrW(1584) & ChrW(1575) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1605) & ChrW(1608) & ChrW(1592) & ChrW(1601) & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & ChrW(1571) & ChrW(1608) & ChrW(32) & ChrW(1571) & _ ChrW(1606) & ChrW(1603) & ChrW(32) & ChrW(1578) & ChrW(1581) & ChrW(1575) & ChrW(1608) & ChrW(1604) & ChrW(32) & ChrW(1578) & ChrW(1587) & ChrW(1580) & _ ChrW(1610) & ChrW(1604) & ChrW(32) & ChrW(1578) & ChrW(1575) & ChrW(1585) & ChrW(1610) & ChrW(1582) & ChrW(32) & ChrW(1594) & ChrW(1610) & ChrW(1585) & _ ChrW(32) & ChrW(1589) & ChrW(1581) & ChrW(1610) & ChrW(1581) strTitle = ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1607) & ChrW(124) & ChrW(67) & ChrW(97) & ChrW(117) & ChrW(116) & ChrW(105) & ChrW(111) & ChrW(110) & ChrW(124) & ChrW(1578) & ChrW(1606) & ChrW(1576) & ChrW(1610) & ChrW(1600) & ChrW(1600) & ChrW(1600) If (dtmNewDate >= dtmMaxStartDate) And (dtmNewDate <= dtmMaxEndDate) Then: MsgBox strMsg, vbOKOnly + vbMsgBoxRight, strTitle: Exit Sub Set db = CurrentDb Set rs = db.OpenRecordset("courses", dbOpenDynaset) With rs .AddNew !num = txtNo !namee = txtName !Cname = txtCname !Cstart = txtCstart !Cend = txtCend .Update End With Set rs = Nothing Set db = Nothing واخيرا المرفق دورات (3) .accdb

فى مربع النص الخاص بكتابة تاريخ بدء الدورة استخدم الكود الاتى قبل التحديث Dim mxDate As Date mxDate = DMax("[Cend]", "courses", "[num] =" & Me.رقم_الموظف & "") If Me.بداية_الدورة <= mxDate Then Cancel = True: Me.Undo: MsgBox "nooooooooooo"

اتفضل يا سيدى ان شاء الله يكون ده طلبك Database2 (3).accdb

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

شكرا لك استاذ محمد لنقلك الفائدة اعيد الحل مع معالجة احتمال التداخل او ما اسميتها بالثغرة Dim Date1, Date2, tstDate As Date Private Sub Cstart_BeforeUpdate(Cancel As Integer) tstDate = Me.Cstart Date1 = DMax("[Cstart]", "courses", "[num] =" & Me.num) Date2 = DMax("[Cend]", "courses", "[num] =" & Me.num) If (tstDate >= Date1) And (tstDate <= Date2) Then Cancel = True MsgBox "يوجد دورة مسجلة بهذا التاريخ " Me.Undo End If End Sub Private Sub Cend_BeforeUpdate(Cancel As Integer) If (Me.Cend >= Date1) Then Cancel = True MsgBox "يوجد دورة مسجلة بهذا التاريخ " Me.Undo End If End Sub دورات2.accdb

عند اختيار تصنيف الصادر (رد على وارد) (ReplayS) تتفعل و (SureS) غير مفعلة من ReplayS الي هي خياراتها (كتاب وارد / برقية وارد) لو تم اختيار كتاب وارد يتفعل ويظهر z1 + z2 فقط ولو تم اختيار برقية وارد يتفعل ويظهر z5 + z6 فقط بعدها لو اختيار تصنيف الصادر (تأكيد على صادر) (ReplayS) غير مفعلة و (SureS) مفعلة من SureSالي هي خياراتها (كتاب صادر / برقية صادر) لو تم اختيار كتاب صادر يتفعل ويظهر z7 + z8 فقط ولو تم اختيار برقية وارد يتفعل ويظهر z3 + z4 فقط

عند اختيار تصنيف الصادر (جديد) (ReplayS - SureS) غير مفعلات و z1 - z2 - z3 -z4 - z5 - z6 - z7 - z8 يختفو (اصلا مختفين) وعند اختيار تصنيف الصادر (رد على وارد) (ReplayS) تتفعل و (SureS) غير مفعلة وعند اختيار تصنيف الصادر (التأكيد على الصادر ) (ReplayS) غير مفعلى و (SureS) مفعلة

اخي الكريم من بعد إذن الإدارة ، لاحظ أن العنوان والمحتوى لا يتفقان ، ولا يوضحان مطلبك للمساعدة التي ترغب بتلقيها ☺️. حتى لا يتم إغلاق الموضوع ( تقبلني بصدر رحب 😊 )

أخي أحذف علامات الاقتباس من الأسماء بيصير الأسماء مرتبة . db1-1.mdb

حضرتك انا والله مش عندى اسكانر الان وانتقلت من عملى لذلك لا استطيع تجربة اى شئ ولكن هل قمت بتجربة المرفق الذى اشرت اليه فى مشاركتى ؟!

السلام عليكم اساتذتي الاعزاء استاذ @زياد الحسناوي قلت سابقا ان لدي سكانر كانون فيدر كما في الصورة عند وضع اي كود لسحب الصور من الماسح الضوئي يسحب صورة واحدة فقط وعند الدخول الى اعدادات الجهاز وجدت هنالك خيارين لعمل سكانر 1- مصدر الورق (paper source) = flatbed وهو يقوم بسحب صورة واحدة فقط وهو الخيار الافتراضي للجهاز 2- مصدر الورق (document feeder ) = وهو يقوم بسحب صورة متعددة (اكثر من صورة) سؤالي هل يمكن وضع دالة if او غير ذلك لغرض اختيار نوع المسح الضوئي اما صورة واحدة او متعدد الصور وشكرا

استنى انا بهزر معاك طبعا انا عارف البيانات دى موجوده هنا وفتحت القاعدة Users id Username Password Full_Name Email User BackUp Aqsat 1 Admin admin مسؤول الصالة الرياضية Yes True Yes فى الجدول ده بس انا باتكلم عن كلمة السر التانية اللى هى 12345 بتاعة المهندس واللى مش موجودة فى الجدول واللا القاعدة دى مش بتاعتك واللا ايـــــه

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

اولا وقبل كل شئ اسأل الله تعالى لوالدكم و والدى وكل المسلين الرحمة والمغفرة وان يحعل الله قبورهم روضة من الجنة يارب العالمين واسأل الله تعالى لوالدتكم و والدتى الحبيبة وكل مريض الشفاء من الله عزوجل وان يرزقكم ويرزقنى وكل المسلمين بر ابائنا وامهاتنا يارب العالمين ثانيا انت نسيت تقول كلمة المرور ومش عارف اجرب يا سلام لو كانت سهلا مثلا 12345 عشان اعرف اجرب

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

CurrentDb.Execute _ "Update Table2 SET File_Type='" & Me.File_Type & "'" & " Where id=" & Me.id لا حاجة للاستعلامات فقط ضع هذا الامر تحت حدث زر الامر في النموذج

مشاركتي مع الأحبة 🙂 تضع هذا في حدث قبل التحديث للنموذج (غيرت المسميات بالإنجليزي) : Private Sub Form_BeforeUpdate(Cancel As Integer) Dim C As Integer C = DCount("*", "[courses]", "([num] =" & Me.num & ") and (([Cstart] Between #" & Me.Cstart & "# And #" & Me.Cend & "#) Or ([Cend] Between #" & Me.Cstart & "# And #" & Me.Cend & "#))") If C > 0 Then MsgBox "الموظف مسجل في دورة أخرى في نفس التوقيت" Cancel = True End If End Sub دورات.accdb

اخي الكريم ، هذا مثال جزء من برنامج ادارة صالات الأفراح ، وفيه فكرة الحجز بتاريخ لصالات ، هي مجرد فكرة جربها ( 10001 و 10002 ) لتجربة الحجز بتاريخ محدد ، وجرب حجز موعد بتاريخ آخر لنفس الرقم Afra7 2023.zip

مشاركة مع احبتي واقتباس من ابي جودي لاحظ تغير مسميات الحقول في النموذج Private Sub Cstart_BeforeUpdate(Cancel As Integer) Dim Date1, Date2, tstDate As Date tstDate = Me.Cstart Date1 = DMax("[Cstart]", "courses", "[num] =" & Me.num) Date2 = DMax("[Cend]", "courses", "[num] =" & Me.num) If (tstDate >= Date1) And (tstDate <= Date2) Then Cancel = True: Me.Undo: MsgBox "nooooooooooo" End Sub

بارك الله فيك اخي عمر اقصد هذا الشريط عندما تختار القائمة منه تستطيع اختيار خيارات منه

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

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

أقوم باسخراج الرقم التسلسلي للتاريخ الهجري بعد تبديل نوع التقويم إلى الهجري، ثم أضيفه في خانة الميلادي (كرقم تسلسلي)، وتنسيق الخلية هو من يظهره كتاريخ. يعني لا بد من تنسيق خلايا التاريخ الميلادي كتاريخ.

بارك الله فى المكتبة وصاحبها يا استاذ @Moosak صار الان حتما ولابد من فرض ضريبه على المكتبة العامرة اوماااااااااااااااااااااال

لتعم الفائدة بشكل اكبر وتصل للجميع سارفق لكم ملف مضغوط فيه كل اسماء الأوامر والازرار الموجودة في مجموعة الاوفيس ، وطريقة استخدامها في xml على الشكل التالي <control idMso="ExportExcel" label="Export to Excel" enabled="true"/> اما المجموعات تضاف باستخدام المجموعة والتاب باستخدام التاب وهكذا كما هو متعارف عليه في xml Office2013FluentUserInterfaceControlIdentifiers.zip

اتفضل Show Report On Form.accdb

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

وعليكم السلام ورحمه الله وبركاته تفضل اخى @هانى محمد Option Explicit Sub Test() Dim WS As Worksheet, SH As Worksheet, Lr As Long, i As Long, A, B, C, D, E As Long, WF As Object Set WS = ThisWorkbook.Worksheets("Setting") Set SH = ThisWorkbook.Worksheets("Main") Lr = SH.Cells(Rows.Count, 1).End(xlUp).Row ReDim arr(3 To Lr, 1 To 2) For i = 3 To Lr A = Application.Match(SH.Range("B" & i), WS.Columns("a"), 0) If Not IsError(A) Then B = Application.Match(SH.Range("C" & i), WS.Columns("BB"), 0) If Not IsError(B) Then C = Application.Match(SH.Range("F" & i), WS.Rows(1), 0) If Not IsError(C) Then If SH.Range("F" & i) = "Marsa Alam" Or SH.Range("F" & i) = "Cairo" Then E = 8 Else E = 9 End If D = Application.Match(SH.Range("e" & i), WS.Range(WS.Cells(2, C), WS.Cells(2, C + E)), 0) - 1 If Not IsError(D) Then arr(i, 1) = WS.Cells(A, C + D) arr(i, 2) = WS.Cells(A, C + D + 1) End If End If End If End If Next i SH.Range("G3").Resize(UBound(arr, 1) - 2, UBound(arr, 2)).Value2 = arr End Sub

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

الاحتمالات كثيرة جرب أن تفتح الملف من على الجهاز الرئيسي من خلال الشبكات ثم فتح الجهاز ثم فتح الملف لأنه ربما الاختصار shortcut يكون غير دقيق وتأكد من صلاحيات هذا الجهاز هل له صلاحية لتعديل الملفات على الشبكة أو الوصول إليها أظن أن هذا الجهاز لا يفتح الملف على السيرفر وإنما يفتح ملفا آخر به البيانات حتى شهر 3

تفضل هذا الملف .على الرغم ان كان عليك من البداية رفع ملف بالمشاركة فلا تعنى أى مشاركة شيء بدون ملف يدعمها Colored.xlsb

وعليكم السلام-تفضل هذا الكود Sub ColorPaletteDialogBox() Dim lcolor As Long If Application.Dialogs(xlDialogEditColor).Show(10, 0, 125, 125) = True Then 'user pressed OK lcolor = ActiveWorkbook.Colors(10) ActiveCell.Interior.Color = lcolor Else 'user pressed Cancel End If End Sub

بارك الله فيك وزادك الله من فضله -جمعة مباركة ان شاء الله

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

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

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

بارك الله فيك وزادك الله من فضله هدية قيمة أحسنتم

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

السلام عليكم -يمكنك ذلك بإستخدام هذه المعادلة داخل Data Validation =YEAR($C2)<=2000 عدم قبول ادخال تاريخ قبل سنة معينة.xlsx

نعم اخي ده مثال للفائدة فقط يمكنك تطويعه بما يناسبك وللعلم يمكن حدف اي ورقة من اوراق العمل سيقوم الملف بتحديث البيانات تلقائيا دون اي مشكلة اخي على العموم اليك الملف ب 3 اوراق فقط وورقة خاصة ب (Admin) لتعديل كلمات المرور test3.xlsm

وعليكم السلام -يمكنك استخدام هذه المعادلة =IFERROR(INDEX(ورقة1!B2:B270,MATCH(0,COUNTIF($A$1:A1,ورقة1!B2:B270),0)),"") تلخيص1.xlsx

2,1/ هذا جزء أساسى بالمعادلة لإستخراج أخر عملية ولا تصلح المعادلة بدون هذه الجزئية وهذا الكود لطلبك الأخر ورجاءاً لابد من غلق المشاركة فلا يمكن ان يكون هناك أكثر من طلب بالمشاركة الواحدة ..فإنت أردت طلبات أخرى لابد من عمل مشاركة جديدة بالطلبات الجديدة ولكم جزيل الشكر Sub RowDeleter() On Error Resume Next Application.ScreenUpdating = False Range("E1:E" & Range("E" & Rows.Count).End(3)(1).Row).AutoFilter 1, 0 Range("E4:E" & Range("E" & Rows.Count).End(3)(1).Row).SpecialCells(12).EntireRow.Delete ActiveSheet.AutoFilterMode = False Application.ScreenUpdating = True End Sub Aziz3.xlsb

وعليكم السلام-ياريت تقوم بتغيير عنوان المشاركة ليصبح ( معادلة IF متعددة الشروط) وهذه المعادلة تفى بالغرض وشكراً =IF(AND($C4<>"غ",$B4="ذكر"),"ناجح",IF(AND($C4<>"غ",$B4="أنثي"),"ناجحة",IF(AND($C4="غ",$B4="ذكر"),"ناجح بحكم القانون",IF(AND($C4="غ",$B4="أنثي"),"ناجحة بحكم القانون","")))) معادلة IF.xlsx

وعليكم السلام-تفضل هذه المعادلة تخص اللون الأخضر =COUNTIFS($G$5:$G$700,">=9",$G$5:$G$700,"<=10") أما اللون الأحمر فيكفيك هذه المعادلة ...وشكراً =COUNTIF($G$5:$G$700,"<=4") فرق بين تاريخين.xlsx

السلام عليكم الملف المرفق يوجد فيه حقل تصنيف الصادر عند اختيار جديد / التاكيد على صادر / الرد على وارد تم عمل الدالة If بنجاح و كذلك عند اختيار تصنيف الصادر (رد على الوارد) و اختيار رد على (كتاب وارد / برقية وارد) تعمل بنجاح وتظهر الحقول المطلوب ولكن عند اختيار تصنيف الصادر (التأكيد على الصادر) تم اختيار التأكيد على (برقية صادر / كتاب صادر) فأنها لا تعمل Database2.accdb