Foksh

👏🏻 اختصار جميل وبسيط يحقق الهدف إذا كانت رغبة أخي @ازهر عبد العزيز هي التحويل من AM الى PM فقط ، ولا يرغب بتطبيق التغيير من PM الى AM على سبيل المثال!! واتنازل عن اختيار الإجابة الأفضل مرشحاً إجابته 🤗 .

وعليكم السلام ورحمة الله وبركاته ،، لم أقم بتحميل الملف ، ولكن من خلال زر في حدث عند النقر على سبيل المثال ، Me.TextBoxName.DefaultValue = """القيمة الجديدة""" استبدل عبارة القيمة الجديدة بما يناسبك. واسم مربع النص TextBoxName جرب وأخبرني بالنتيجة 🤗.

ومشاركة مع الأستاذ @عبد اللطيف سلوم ، هذه فكرتي ، الدالة التالية Function ToggleAMPM(timeValue As Date) As Date If Format(timeValue, "AM/PM") = "AM" Then ToggleAMPM = DateAdd("h", 12, timeValue) Else ToggleAMPM = DateAdd("h", -12, timeValue) End If End Function time.accdb

متابع 😇

نعم صحيح ، على إصدار 2010 اشتغل الملف بشكل طبيعي وبدون اي مشاكل ، لكن على اصدار 2016 عندي لم يعمل للأسف ..

المشكلة في دالة BrowseForFolder على ما اعتقد ، وانا ايضاً لم يتم فتح مربع حوار اختيار مكان الحفظ . أما بالنسبة لي فأعتقد أنه من المفترض أن تكون النسخة الاحتياطية مؤمنة ومحفوظة في مكان واحد بشكل تلقائي داخل مجلد بجانب قاعدةالبيانات على سبيل المثال ، وأيضاً لي وجهة نظر مختلفة فيما يتعلق بموضوع النسخ الإحتياطي . فمثلاً ما حاجتي اذا كان النسخ الإحتياطي سيقوم بإنشاء نسخة كاملة من البرنامج ( الجداول والنماذج والاستعلامات .... إلخ ) تحت مسمى النسخة الإحتياطية !!!!!!! برأيي ان النسخة الاحتياطية للجداول فقط هي ما يهم المستخدم . لذا دائما أتوجه الى أخذنسخة احتياطية للجداول فقط . وهذا مرفق بسيط قديم من أحد مشاركاتي حسب طلب صاحب الموضوع السابق حينها ، ويتعامل مع القاعدة المنقسمة . Back.accdb

وعليكم السلام ورحمة الله وبركاته .. يمكن تنفيذ الفكرة بأكثر من طريقة ، ولكن ما يخطر في بالي حالياً هو :- 1. اضافة حقل من نوع Yes/No في الجدول المخصص للسندات على سبيل المثال ( افتراضاً حسب تصميم وهيكلة الجداول لديك ) . 2. في واجهة المدير يحتاج الأمر لنموذج يعرض السندات التي تكون فيها قيمة الحقل السابق = ( No أو 0 ) . وطبعاً سيكون الموضوع مرتبط برقم السند بحيث عند النقر على زر الموافقة يتم تحديث قيمة الحقل من 0 الى -1 ( من No إلى Yes ) . 3. في نموذج و واجهة المستخدم أو الموظف سيكون في الزر المخصص بتغيير القيمة أوزر مخصص لتفقد حالة السند ( تمت الموافقة أم لا ) بجملة شرطية If مع Dlookup تعود بقيمة الحقل لرقم السند المحدد ، فإذا تمت الموافقة ( أي قيمة الحقل = Yes أو -1 ) يسمح بالتعديل وإلا فلا يسمح بذلك . هذا تصوري لفكرة سريعة وطبعاً هذا يعتمد على خيالك ومهارتك البرمجية

بعد بحثي عن هذا الملف من مشروع إدارة صالة أفراح في العاصمة عمان ، جرب هذا التعديل :- Afra7.accdb

انظر المشكلة :- لاحظ كيف يتم تخزين قيم العنوان الإلكتروني في الجدول داخل الحقل !!!! وهذا مرفقك لتتوضح الصورة لك !! hyperlinErr.accdb

اخي الكريم الموديول ليس له علاقة بهذا الملف .

من نفس المرفق أخي عبداللطيف :-

وعليكم السلام ورحمة الله وبركاته ,, في النموذج ، وبعد ان تحدد مربع النص الذي يتم عرض الروابط فيه ، من تبويب Format - تنسيق ، فعل الخيار التالي :- لتحصل على النتيجة :- إضافة الى ما سبق ، تستطيع إضافة الكود التالي لمربع النص في حدث عند النقر :- Dim link As String link = Me.Emails.Value If link <> "" Then Application.FollowHyperlink link End If حيث في مثال ، اسم مربع النص هنا = Emails

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

لا تحتاج لشرح ، تفقد مرفق الأستاذ @ابو جودي ،والمرفق التالي وستعرف الحل البسيط 1.accdb

وعليكم السلام ورحمة الله وبركاته .. الأمر يسير أخي @عبد اللطيف سلوم ان شاء الله انشئ نموذج وفي زر التسجيل استخدم الكود التالي Private Sub Command7_Click() Dim rs As DAO.Recordset Dim sql As String sql = "SELECT 1 FROM Tbl_Party WHERE DATE_PARTY = #" & Me.DATE_PARTY & "# " & _ "AND ((#" & Me.TIME_PARTY_START & "# BETWEEN TIME_PARTY_START AND TIME_PARTY_END) " & _ "OR (#" & Me.TIME_PARTY_END & "# BETWEEN TIME_PARTY_START AND TIME_PARTY_END) " & _ "OR (TIME_PARTY_START BETWEEN #" & Me.TIME_PARTY_START & "# AND #" & Me.TIME_PARTY_END & "#))" Set rs = CurrentDb.OpenRecordset(sql, dbOpenSnapshot) If Not rs.EOF Then MsgBox "يوجد حجز مسبق لهذه الفترة!", vbExclamation, "تنبيه" Else CurrentDb.Execute "INSERT INTO Tbl_Party (DATE_PARTY, TIME_PARTY_START, TIME_PARTY_END) " & _ "VALUES (#" & Me.DATE_PARTY & "#, #" & Me.TIME_PARTY_START & "#, #" & Me.TIME_PARTY_END & "#)", dbFailOnError MsgBox "تم حفظ الحجز بنجاح!", vbInformation, "تأكيد" End If rs.Close: Set rs = Nothing End Sub WEEDING HALLS.accdb

زي كده

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

ما شاء الله ، تبارك الرحمن سلمت يمناك لهذا الطرح الممتع ,, وجزاك الله كل الخير على مجهودك الجميل والكبير حتى تصل لهذه النتيجة .. اسمح لي بسؤال خطر على بالي :- بما أن الكود يعتمد على مكتبة DAO ؛ هل سيدعم الإصدارات القديمة التي لا تدعم هذه المكتبة !!!

أتمنى أن أكون قد فهمت الفكرة بشكل صحيح .. جرب هذا الكود في الزر Private Sub أمر7_Click() Dim strCriteriaHall1 As String, strCriteriaHall2 As String Dim HallName1 As String, HallName2 As String Dim checkInDate As String Dim existingClient1 As Variant, existingClient2 As Variant Dim existingCheckIn1 As Variant, existingCheckIn2 As Variant Dim existingCheckOut1 As Variant, existingCheckOut2 As Variant HallName1 = Replace(Me.m3.Caption, "'", "''") HallName2 = Replace(Me.m5.Caption, "'", "''") checkInDate = "#" & Format(Me.m4, "mm/dd/yyyy") & "#" strCriteriaHall1 = "HallName='" & HallName1 & "' AND Check_in <= " & checkInDate & " AND Check_out >= " & checkInDate strCriteriaHall2 = "HallName='" & HallName2 & "' AND Check_in <= " & checkInDate & " AND Check_out >= " & checkInDate existingClient1 = DLookup("Client_Name", "tbl_HallReservation", strCriteriaHall1) existingCheckIn1 = DLookup("Check_in", "tbl_HallReservation", strCriteriaHall1) existingCheckOut1 = DLookup("Check_out", "tbl_HallReservation", strCriteriaHall1) existingClient2 = DLookup("Client_Name", "tbl_HallReservation", strCriteriaHall2) existingCheckIn2 = DLookup("Check_in", "tbl_HallReservation", strCriteriaHall2) existingCheckOut2 = DLookup("Check_out", "tbl_HallReservation", strCriteriaHall2) If Not IsNull(existingClient1) Then Me.aa.Value = "القاعة غير متاحة" Me.bb.Value = "الاسم: " & existingClient1 & vbNewLine & _ "القاعة: " & HallName1 & vbNewLine & _ "تاريخ الدخول: " & Format(existingCheckIn1, "dd/mm/yyyy") & vbNewLine & _ "تاريخ الخروج: " & Format(existingCheckOut1, "dd/mm/yyyy") Else Me.aa.Value = "متاحة" Me.bb.Value = "لا توجد حجوزات سابقة لهذه القاعة" End If If Not IsNull(existingClient2) Then Me.DD.Value = "القاعة غير متاحة" Me.ff.Value = "الاسم: " & existingClient2 & vbNewLine & _ "القاعة: " & HallName2 & vbNewLine & _ "تاريخ الدخول: " & Format(existingCheckIn2, "dd/mm/yyyy") & vbNewLine & _ "تاريخ الخروج: " & Format(existingCheckOut2, "dd/mm/yyyy") Else Me.DD.Value = "متاحة" Me.ff.Value = "لا توجد حجوزات سابقة لهذه القاعة" End If End Sub حجز (2).accdb

استغفر الله العظيم ، أخي العزيز الأستاذ @ابو جودي ، أسأل الله لكم الفلاح والنجاح في الدنيا والآخرة ، وأن يزيدكم الله من علمه لما علمكم ,, < انتهينا من دي !! ايه الكلام ده يا عم الحج .. انت حتسيح بقلب المنطقة !!!! هو انا كنت عملت ايه !! ولا هي تتبلاني وخلاااص . وبعدين انا كنت بجاوب هنا أو هناك ؛ تنكر !!! صدقني لهو شرف لي أن أشاطرك الأفكار بكل ود وحب .. شكراً على كلامك الجميل ( محدش يصدقه )

حسناً ، جرب هذا التعديل ، حيث استخدمنا Do Until بدلاً من Continue For .. If Month(Me.txtMonth) = 3 Or Month(Me.txtMonth) = 7 Then myCriteria = "([detach] IN ('موظف', 'عامل متعاقد توقيت كامل', 'عامل متعاقد توقيت جزئي', 'حارس متعاقد توقيت جزئي', 'عون نظافه وتطهير'))" Set rstE = CurrentDb.OpenRecordset("SELECT * FROM Employee WHERE " & myCriteria) If Not rstE.EOF Then Do Until rstE.EOF If DCount("*", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & " AND [Loan_Type]='Inkhirat' AND [Payment_Month]=#" & Me.txtMonth & "#") = 0 Then rst.AddNew rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 rst!Payment_Month = Me.txtMonth rst!Payment_Made = DLookup("Other_Value", "TblOther", "ID=1") rst!Loan_Type = "Inkhirat" rst!Nr = GetNumDetach(rstE!EmployeeID) rst!Remarks = "إقتطاع من الراتب لإنخراط شهر " & Format(Me.txtMonth, "yyyy/mm") rst!sadad = rst!Payment_Made rst!wada3 = "تم الإنخراط" rst.Update TheSum = TheSum + Nz(rst!Payment_Made, 0) End If rstE.MoveNext Loop End If rstE.Close: Set rstE = Nothing End If

تم الإضافة في المشاركة السابقة أخي الكريم ,,

لا انصحك بهذه الخطوة أخي الكريم ، يعني لو العميل حذف السجل 150 من اصل السجلات 350 ، فسيكون الترتيب = 148 - 149 - 151 - 152 .... إلخ وللأسف لن يتم اضافة الرقم 150 !!!!!!!!

باعتقادي وبأنه الكثير لم يفهم تسلسل ولا آلية ولا فكرة المرفق أو كيفية فهم النتائج في هذا المشروع ، اعتقد إنه يتوجب عليك أخي @طاهر اوفيسنا إعادة النظر في الآلية التي تسير بها في مشروعك . هذا من ناحية طبعاً . من ناحية أخرى ما زلت تفتقر الى الشرح المبسط أو الواضح وتوصيل المعلومة التي من خلالها نستطيع فهم ما تريده . وليس تزويدنا بكود وصورة قد يكون كافياً دائماً لفهم المطلوب . على العموم ، جرب هذا التعديل في النهج كاملاً .. Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click Dim rst As DAO.Recordset Dim rstE As DAO.Recordset Dim Rc As Integer, TheSum As Double Dim myCriteria As String Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl_Loans WHERE [Payment_Month]=#" & Format(Me.txtMonth, "mm/dd/yyyy") & "#") If rst.EOF Then MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.txtMonth, "mmmm yyyy"), vbInformation rst.Close: Set rst = Nothing Exit Sub End If With rst If IsNull(!Payment_Made) And Not IsNull(!Loan_Made) Then If MsgBox("هل تريد توزيع الإقتطاعات لشهر " & Format(Me.txtMonth, "mmmm yyyy") & "؟", vbYesNo + vbQuestion) = vbYes Then Do Until .EOF .Edit If !Nr >= 6 Then !Payment_Made = 0 ElseIf !Loan_Type = "Cridi" Or !Loan_Type = "Elec" Then !Payment_Made = !Loan_Made !sadad = !Loan_Made !Loan_Remise = 0 End If !wada3 = IIf(Nz(!sadad, 0) <> 0, "تم التسديد", "لم يتم التسديد") TheSum = TheSum + Nz(!Payment_Made, 0) .Update .MoveNext Loop ' اقتطاع الانخراط في مارس ويوليو If Month(Me.txtMonth) = 3 Or Month(Me.txtMonth) = 7 Then myCriteria = "([detach] IN ('موظف', 'عامل متعاقد توقيت كامل', 'عامل متعاقد توقيت جزئي', 'حارس متعاقد توقيت جزئي', 'عون نظافه وتطهير'))" Set rstE = CurrentDb.OpenRecordset("SELECT * FROM Employee WHERE " & myCriteria) If Not rstE.EOF Then Do Until rstE.EOF If DCount("*", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & " AND [Loan_Type]='Inkhirat' AND [Payment_Month]=#" & Me.txtMonth & "#") = 0 Then .AddNew !EmployeeID = rstE!EmployeeID !Loan_ID = 0 !Payment_Month = Me.txtMonth !Payment_Made = DLookup("Other_Value", "TblOther", "ID=1") !Loan_Type = "Inkhirat" !Nr = GetNumDetach(rstE!EmployeeID) !Remarks = "إقتطاع من الراتب لإنخراط شهر " & Format(Me.txtMonth, "yyyy/mm") !sadad = !Payment_Made !wada3 = "تم الإنخراط" .Update TheSum = TheSum + Nz(!Payment_Made, 0) End If rstE.MoveNext Loop End If rstE.Close: Set rstE = Nothing End If ' عرض المجموع النهائي MsgBox "تم توزيع الإقتطاعات بنجاح." & vbCrLf & "المجموع: " & Format(TheSum, "#,##0.00"), vbInformation, "إقتطاعات شهر " & Format(Me.txtMonth, "mmmm yyyy") End If End If End With rst.Close: Set rst = Nothing Exit Sub err_cmd_Pay_installments_Click: MsgBox "خطأ رقم: " & Err.Number & vbCrLf & Err.Description, vbCritical If Not rst Is Nothing Then rst.Close: Set rst = Nothing If Not rstE Is Nothing Then rstE.Close: Set rstE = Nothing End Sub الكود في ملف نصي مضغوط .. Text_VBA.zip