Foksh

ليس عليك اختيار إجابتي كأفضل إجابة ما لم تكن تريدها بهذا الشكل ، ولكن على العموم شكراً لك وللأسف ليس لدي فكرة كالتي تريدها

ارفق ملف قاعدة البيانات للإطلاع عليه يا صديقي

وهذه مشاركة بطريقة أخرى ، مشاركةً مع معلمي الجليل و والدنا العزيز الأستاذ @ابوخليل .. فكرتين ، الأولى هي بجعل الزر يفتح التقرير بشرطين = DoCmd.OpenReport "qrbook", acViewPreview, , , , Me.fsldrase.Column(1) & ";" & Me.drase.Column(1) وأن نجعل الحدث عند التحميل للتقرير = Dim args As Variant If Not IsNull(Me.OpenArgs) Then args = Split(Me.OpenArgs, ";") Me.Tx_Fasl = args(0) Me.Tx_Yer = args(1) End If والفكرة الثانية كما أشار أستاذي في مشاركته تماماً .. ومرفق زرين كل واحد منهما بطريقة نموذج بحث شامل 1.accdb

وعليكم السلام ورحمة الله تعالى وبركاته.. هذا الخطأ دلالة على ان ملف قاعدة البيانات تالف وغير صالح 🥴 ، طيب هل جربت انك تعمل قاعدة بيانات جديدة وتستورد العناصر والمكونات من القاعدة القديمة التالفة الى الجديدة ؟؟ هي مجرد فكرة طبعاً ، أو انك تفتح قاعدة البيانات باستخدام مفتاح Shift وتحاول تعمل ضغط وإصلاح 🤔 ؟؟ مجرد إحتمالات ما لم ترفق ملف القاعدة.

وعليكم السلام ورحمة الله تعالى وبركاته.. تقدر تستخدام حدث "On Key Down" في النموذج للتحقق مما إذا كان المستخدم قد ضغط على Ctrl + T أو Ctrl + D ثم تغيير خصائص التعديل والحذف بناءً على ذلك . بس طبعاً لازم تتأكد أن خاصية Key Preview في النموذج = Yes 😅 وإلا فلن نستفيد من الكود التالي :- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyT And (Shift And acCtrlMask) <> 0 Then Me.AllowEdits = True MsgBox "تم تفعيل التعديل", vbInformation End If If KeyCode = vbKeyD And (Shift And acCtrlMask) <> 0 Then Me.AllowDeletions = True MsgBox "تم تفعيل الحذف", vbInformation End If End Sub جرب النتيجة النهائية وأخبرنا بها 😇

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

لماذا لم تفلح ، البداية إلى الآن جيدة .. لكن كنصائح للتذكير ليس إلا :- 1. ابتعد عن المسميات العربية للحقول والجداول والعناصر في النماذج والتقارير .. إلخ . 2. ابتعد عن المسميات التي تتكون من مقطعين ، بل حاول استخدام أي رمز مسموج للفصل بين الكلمات على سبيل المثال :- خاطئ = ( Tbl Customer ) الصحيح = ( Tbl_Customer ) . 3. لا تستعمل أسماء محجوزة أو ممنوعة من الاستخدام ، على سبيل المثال أن يكون لديك حقل اسمه Date أو Form .... إلخ ، لأنها ستسبب لك الكثير من المشاكل في العمل لاحقاً . اعتقد هذا ما يخطر ببالي حالياً . أما بخصوص تحويلك لفكرة موقع HTML الى آكسيس فهذا سيتطلب منك جهداً لاحقاً ( ليس لإحباطك ) وإنما لتكون الفكرة واضحة أمامك .

وعليكم السلام ورحمة الله وبركاته ،، أخي الكريم انت تبحث عن مشرع كامل وليس حل لمشكلة محددة !! ليت باستطاعتي الإفادة والمساعدة ، ولكن عل أحد الأخوة ممن لديه وقت وتفرغ ان يساعد . ولكن لم لا تحاول بالجداول أولاً ؟؟؟؟ فعلى الأغلب ، ستحتاج جداول مثل ( المحافظات ، السلع واسعارها وأنواعها ، التاجر ، العميل ... إلخ ) ابدأ خطوتك البسيطة وأكيد ستجد الكثير من الحلول والمساعدات والأفكار قد هلّت عليك .

انا عن نفسي مش عايز اتكلم ، أحسن تقول لي إنت بتكدبني ؟؟؟؟ 🤣 المشكلة إنه سبق وتصادمنا في كتير مواقف بجنب بعض بالأفكار ، ومش حينفع إني أأكد كلامك بإن مفيش دماغ اصلاً ،

وعليكم السلام ورحمة الله وبركاته .. وكالعادة ننوه ونذكر وننصح أخواننا في طلباتهم ومشاركاتهم أن يبتعدوا عن المسميات التي باللغة العربية والتي تحتوي مسافات ( أكثر من كلمة ) ولكن بلا جدوى ، و والله أن النصيحة ليست لي أو لأي شخص يقوم بتقديم حل لأي مشكلة بقدر ما هي ستعود بالفائدة التعليمية وصحة ودقة النتائج العملية لصاحب المشاركة والملف .. على العموم ، قد أعجبتني فكرة الأستاذ @ابو عارف ، فهي بسيطة و تلبي الحاجة المطلوبة بشكل جيد ، ولي رغبة في مشاركته أفكاره بعدة حلول ، أذكر منها حلين في مرفقين اثنين . الأول في الملف المرفق (test (1)) ، في حدث بعد التحديث للكومبوبوكس :- Private Sub اسم_الصنف_AfterUpdate() Dim selectedForm As String Dim currentID As Long selectedForm = Me.اسم_الصنف.Value currentID = Me.ID.Value If Not IsNull(selectedForm) Then DoCmd.OpenForm selectedForm, acNormal, , , , , currentID Else MsgBox "يرجى اختيار قيمة صحيحة!", vbExclamation End If End Sub بحيث يتم تطبيق الفلترة في حدث عند التحميل للنماذج الـ 3 = A,B,C التي ذكرها أخونا الكريم في طلبه :- Private Sub Form_Load() Dim recordID As Long If Not IsNull(Me.OpenArgs) Then recordID = CLng(Me.OpenArgs) Me.Filter = "[ID] = " & recordID Me.FilterOn = True If Not IsNull(Me!نموذج_فرعي_qa) Then Me!نموذج_فرعي_qa.Form.Filter = "[ID] = " & recordID Me!نموذج_فرعي_qa.Form.FilterOn = True End If Else MsgBox "لم يتم تمرير رقم السجل بشكل صحيح", vbExclamation End If End Sub الثاني في الملف المرفق (test (2)) ، في حدث بعد التحديث للكومبوبوكس :- Private Sub اسم_الصنف_AfterUpdate() Dim selectedForm As String Dim currentID As Long selectedForm = Me.اسم_الصنف.Value currentID = Me.ID.Value If Not IsNull(selectedForm) Then DoCmd.OpenForm selectedForm, acNormal, , , , , currentID Else MsgBox "يرجى اختيار قيمة صحيحة", vbExclamation + vbMsgBoxRight End If End Sub وتم نقل الكود لضمان عدم تكراره في النماذج الى وحدة نمطية مع إجراء بعض التعديلات ، بحيث يصبح الكود منفصلاً كالتالي :- Public Sub ApplyRecordFilter(frm As Form, Optional subFormName As String = "", Optional recordID As Variant) If IsNull(recordID) Or recordID = "" Then MsgBox "لم يتم تمرير رقم السجل بشكل صحيح", vbExclamation + vbMsgBoxRight Exit Sub End If frm.Filter = "[ID] = " & recordID frm.FilterOn = True If subFormName <> "" Then On Error Resume Next If Not IsNull(frm.Controls(subFormName)) Then frm.Controls(subFormName).Form.Filter = "[ID] = " & recordID frm.Controls(subFormName).Form.FilterOn = True Else MsgBox "لم يتم العثور على النموذج الفرعي " & subFormName, vbExclamation + vbMsgBoxRight End If On Error GoTo 0 End If End Sub والإستدعاء يكفينا في النماذج الفرعية كالتالي :- Private Sub Form_Load() ApplyRecordFilter Me, "نموذج_فرعي_qa", Me.OpenArgs End Sub قمنا بتمرير قيمة الـ ID إلى النموذج الرئيسي باستخدام OpenArgs لأنها طريقة آمنة وموثوقة بالنسبة لي ، ثم سنطبق الفلتر داخل حدث تحميل النموذج ( On Load ) مباشرة بعد أن يفتح بالكامل وفي الفكرتين لن نحتاج أي روابط بين الحقول ( Link Master Fields & Link Child Fields ) لأننا سنعتمد على الفلتر يدوياً . المرفقات للطريقتين :- test (1).accdb test (2).accdb

بعد تجربة الفكرة ، وبغض النظر عن أنها تحتاج فعلاً لإنترنت كي تتم المقارنة ، هذه تجربتي الفعلية موضحة في الصورة التالية .. هل من تفسير استاذنا الغالي ؟؟ 😊 ايضاً عند عدم الاتصال بالانترنت بقي التاريخ الدولي هو نفسه ، ولا اعلم مصدره ان لم يكن هناك انترنت في الكمبيوتر !!

لا حاجة للإعتذار ، وانما يسعدني مشاركتك الأفكار ..

لا أزايد على الأستاذ @Barna الغالي فيما تفضل به ، ولكن لضمان عرض الرسالة بشكل منطقي وسهل القراءة ، اعتقد اضافة الجزء vbMsgBoxRight لتحويل نص الرسالة من اليمين الى اليسار كقراءة لللغة العربية سيكون أفضل أيضاً

الفراغ الذي دار الحديث حوله اذا كان مربع النص حقل نصي ، إما اذا كان حقل رقمي فلا حاجة لـ Trim باعتقادي 😁 ولا في حد عنده اعتراض هههههههه

ما دام الأمر متوسعاً إلى هذا الحد 😁 ، فهذه فكرتي المتواضعة البسيطة ، وتضم 3 طرق بشكل (مباشر وغير مباشر ) لتحقيق الهدف مديول عام يضم الأساليب الثلاثة كالتالي :- ' الدالة الأولى: حساب تاريخ التقاعد فقط Public Function CalculateRetirementDate(birthDateControl As Object) As Variant Dim birthDate As Date Dim retirementAge As Integer Dim retirementDate As Date Dim inputDate As String If IsNull(birthDateControl.Value) Or birthDateControl.Value = "" Then MsgBox "يرجى إدخال تاريخ ميلاد", vbExclamation + vbMsgBoxRight CalculateRetirementDate = Null Exit Function End If If Not IsDate(birthDateControl.Value) Then MsgBox "تاريخ الميلاد غير صحيح . يرجى إدخال تاريخ بتنسيق صحيح (يوم/شهر/سنة)", vbExclamation + vbMsgBoxRight CalculateRetirementDate = Null Exit Function End If birthDate = CDate(birthDateControl.Value) If birthDate > Date Then MsgBox "تاريخ الميلاد لا يمكن أن يكون في المستقبل", vbExclamation + vbMsgBoxRight CalculateRetirementDate = Null Exit Function End If If Year(birthDate) < 1900 Then MsgBox "تاريخ الميلاد غير منطقي. يرجى إدخال تاريخ صحيح", vbExclamation + vbMsgBoxRight CalculateRetirementDate = Null Exit Function End If Select Case Year(birthDate) Case Is < 1960 retirementAge = 60 Case 1960 To 1964 retirementAge = 61 Case 1965 To 1969 retirementAge = 62 Case 1970 To 1974 retirementAge = 63 Case 1975 To 1979 retirementAge = 64 Case Is >= 1980 retirementAge = 65 Case Else MsgBox "تاريخ الميلاد خارج نطاق الحساب", vbExclamation + vbMsgBoxRight CalculateRetirementDate = Null Exit Function End Select retirementDate = DateAdd("yyyy", retirementAge, birthDate) - 1 CalculateRetirementDate = retirementDate End Function ' الدالة الثانية: حساب تاريخ التقاعد فقط (غير منضم) Public Function GetRetirementDateByBirth(birthDateInput As Object) As Variant Dim inputBirthDate As Date Dim ageAtRetirement As Integer Dim calculatedRetirementDate As Date If IsNull(birthDateInput.Value) Or birthDateInput.Value = "" Then GetRetirementDateByBirth = "لم يتم إدخال تاريخ ميلاد لهذا الموظف" Exit Function End If If IsDate(birthDateInput.Value) Then inputBirthDate = CDate(birthDateInput.Value) Select Case Year(inputBirthDate) Case Is < 1960 ageAtRetirement = 60 Case 1960 To 1964 ageAtRetirement = 61 Case 1965 To 1969 ageAtRetirement = 62 Case 1970 To 1974 ageAtRetirement = 63 Case 1975 To 1979 ageAtRetirement = 64 Case Is >= 1980 ageAtRetirement = 65 Case Else MsgBox "تاريخ الميلاد خارج نطاق الحساب", vbExclamation + vbMsgBoxRight GetRetirementDateByBirth = Null Exit Function End Select calculatedRetirementDate = DateAdd("yyyy", ageAtRetirement, inputBirthDate) - 1 GetRetirementDateByBirth = calculatedRetirementDate Else MsgBox "يرجى إدخال تاريخ ميلاد صحيح", vbExclamation + vbMsgBoxRight GetRetirementDateByBirth = Null End If End Function ' الدالة الثالثة: حساب تاريخ التقاعد مع المدة المتبقية Public Function CalculateRetirementInfo(birthDateField As Object) As String Dim employeeBirthDate As Date Dim retirementAge As Integer Dim retirementDate As Date Dim timeRemaining As String Dim currentDate As Date currentDate = Date If IsNull(birthDateField.Value) Or birthDateField.Value = "" Then CalculateRetirementInfo = "لم يتم إدخال تاريخ ميلاد لهذا الموظف" Exit Function End If If IsDate(birthDateField.Value) Then employeeBirthDate = CDate(birthDateField.Value) Select Case Year(employeeBirthDate) Case Is < 1960 retirementAge = 60 Case 1960 To 1964 retirementAge = 61 Case 1965 To 1969 retirementAge = 62 Case 1970 To 1974 retirementAge = 63 Case 1975 To 1979 retirementAge = 64 Case Is >= 1980 retirementAge = 65 Case Else CalculateRetirementInfo = "تاريخ الميلاد خارج نطاق الحساب" Exit Function End Select retirementDate = DateAdd("yyyy", retirementAge, employeeBirthDate) - 1 timeRemaining = GetTimeRemaining(currentDate, retirementDate) CalculateRetirementInfo = "تاريخ سن التقاعد في : " & Format(retirementDate, "dd/mm/yyyy") & " ، وبقي عليه " & timeRemaining Else CalculateRetirementInfo = "تاريخ الميلاد غير صحيح" End If End Function ' دالة مساعدة: حساب الفرق بين تاريخين Public Function GetTimeRemaining(startDate As Date, endDate As Date) As String Dim yearsDiff As Integer Dim monthsDiff As Integer Dim daysDiff As Integer Dim yearsText As String Dim monthsText As String Dim daysText As String yearsDiff = DateDiff("yyyy", startDate, endDate) If DateAdd("yyyy", yearsDiff, startDate) > endDate Then yearsDiff = yearsDiff - 1 End If monthsDiff = DateDiff("m", DateAdd("yyyy", yearsDiff, startDate), endDate) If DateAdd("m", monthsDiff, DateAdd("yyyy", yearsDiff, startDate)) > endDate Then monthsDiff = monthsDiff - 1 End If daysDiff = DateDiff("d", DateAdd("m", monthsDiff, DateAdd("yyyy", yearsDiff, startDate)), endDate) Select Case yearsDiff Case 1, 2 yearsText = "سنة" Case 3 To 10 yearsText = "سنوات" Case Else yearsText = "سنة" End Select Select Case monthsDiff Case 1, 2 monthsText = "شهر" Case 3 To 10 monthsText = "أشهر" Case Else monthsText = "شهر" End Select Select Case daysDiff Case 1, 2 daysText = "يوم" Case 3 To 10 daysText = "أيام" Case Else daysText = "يوم" End Select GetTimeRemaining = yearsDiff & " " & yearsText & " و " & monthsDiff & " " & monthsText & " و " & daysDiff & " " & daysText End Function والفكرة الأولى لحدث بعد التحديث لمربع نص تاريخ الميلاد = الفكرة الأولى تتحقق بشكل مباشر من خلال حدث بعد التحديث دون دالة في وحدة نمطية Private Sub TEmp_BirthDate_AfterUpdate() Dim birthDate As Date Dim retirementAge As Integer Dim retirementDate As Date If IsDate(Me.TEmp_BirthDate) Then birthDate = Me.TEmp_BirthDate Select Case Year(birthDate) Case Is < 1959 retirementAge = 60 Case 1959 To 1961 retirementAge = 61 Case 1962 To 1964 retirementAge = 62 Case 1965 To 1967 retirementAge = 63 Case 1968 To 1970 retirementAge = 64 Case Is >= 1971 retirementAge = 65 Case Else MsgBox "تاريخ الميلاد خارج نطاق الحساب", vbExclamation + vbMsgBoxRight Exit Sub End Select retirementDate = DateAdd("yyyy", retirementAge, birthDate) - 1 Me.M2 = retirementDate Else MsgBox "يرجى إدخال تاريخ ميلاد صحيح", vbExclamation End If End Sub والفكرة الثانية لحدث بعد التحديث لمربع نص تاريخ الميلاد = 'الفكرة الثانية تتحقق بشكل مباشر من خلال حدث بعد التحديث باستخدام دالة في وحدة نمطية Private Sub TEmp_BirthDate_AfterUpdate() Dim retirementDate As Variant retirementDate = CalculateRetirementDate(Me.TEmp_BirthDate) If Not IsNull(retirementDate) Then Me.M2 = retirementDate End If End Sub الفكرة الثالثة والرابعة من خلال مصدر بيانات مربع النص لمربع سن التقاعد أو المعاش = =GetRetirementDateByBirth([TEmp_BirthDate]) أو لإظهار التفاصيل للمدة المتبقية مع تاريخ سن التقاعد أو المعاش = =CalculateRetirementInfo([TEmp_BirthDate]) سن التقاعد.accdb

وعليكم السلام ورحمة الله وبركاته .. كمعلومة من أحد الإصدقاء لي في مصر الشقيقة ,, هل قانون التأمينات الجديد لعام 2019 بيحدد سن المعاش تدريجياً حسب سنة الميلاد بالشكل التالي :- مواليد قبل 1/1/1959 : سن التقاعد 60 سنة ، مواليد من 1959 إلى 1961 : سن التقاعد 61 سنة ، مواليد من 1962 إلى 1964 : سن التقاعد 62 سنة ، مواليد من 1965 إلى 1967 : سن التقاعد 63 سنة ، مواليد من 1968 إلى 1970 : سن التقاعد 64 سنة ، مواليد 1971 وما بعدها : سن التقاعد 65 سنة ؟؟؟؟؟؟؟

وعليكم السلام ورحمة الله وبركاته ,, أخي جو لم كل هذا ، تستطيع استخدام التنسيق الشرطي لتغيير لون خلفية مربع النص Pname ( اسم المريض ) فقط ، بدلاً من تحميل النموذج المستمر الفرعي حملاً زائداً مع وجود تنسيقات شرطية أخرى لمربعات النص الأخرى ( إن وُجد ) .. أضف إلى ذلك ، لضمان تغيير لون خلفية مربع النص دون مشاكل ، يجب ان تختار لون خلفية لمربع النص الي قمت بتحديد تنسيقات شرطية له ، بحيث اذا كان مربع النص لونه شفاف فإن التنسيق الشرطي لتغيير لون الخلفية لن يعمل ( وجهة نظري ) .

الحمد لله 😇 هل اكتشفت اين كان الخلل 😁😉 ؟؟؟

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

هل تمت التجربة بأكثر من احتمال !!!!!!!!!

أخي العزير @jo_2010 ، المرفق الذي ارفقته لا يطابق الصورة في ردك الأخير !!!!!!!!!!!!!!! فكيف برأيك سأعرف ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ في ملفك المرفق وتعديلي عليه وبعد تجربته يعمل بدون أي مشاكل . أما في ملفك الغير موجود بين الأيدي فلا أعلم المشكلة التي تواجهها ..

اين النموذج قوائم الذي به مربع التحرير والسرد 😥 ؟ جرب المرفق التالي :- Database.accdb

حسناً ، جرب هذا التعديل البسيط ,, Private Sub Comannd187_Click() Dim fdialog As Office.FileDialog Dim filepath As String Dim sdialog As New WIA.CommonDialog Dim imagefile As WIA.imagefile On Error GoTo errorhandle Dim fso As Object Dim fldrname, fldrpath, FoldrPath As String FoldrPath = "Pictures" Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & FoldrPath If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) End If '================================== Set fdialog = Application.FileDialog(msoFileDialogSaveAs) filepath = CurrentProject.Path & "\" & FoldrPath & "\" & Me.Key & ".jpg" Set imagefile = sdialog.ShowAcquireImage() imagefile.SaveFile filepath Me.PicPath2 = filepath Image.Requery errorhandleexit: Exit Sub errorhandle: If Err.Number = "-2147024816" Then If MsgBox("توجد صورة تحمل نفس الرقم" & vbNewLine & "هل تريد حذف الصورة القديمة" & vbNewLine & "في حال الرفض سيتم اضافة رقم عشوائي الى اسم الصورة لتمييزها", vbCritical + vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then Kill filepath 'Set imagefile = sdialog.ShowAcquireImage() imagefile.SaveFile filepath Me.PicPath2 = filepath Image.Requery Else Dim g As String g = CurrentProject.Path & "\" & FoldrPath & "\" & Me.Key & "-" & Format(Now, "hhnnss") & ".jpg" imagefile.SaveFile g Me.PicPath2 = g Me.Image1.Picture = Me.Pic1 End If ElseIf Err.Number = "-2145320939" Then MsgBox "الاسكانر غير متصل", vbCritical + vbMsgBoxRight, "تنبيه" Else Me.PicPath2 = Err.Number MsgBox Err.Description End If Resume errorhandleexit End Sub

وعليكم السلام ورحمة الله وبركاته .. حالياً لعدم توافر ماسح ضوئي حالياً لدي ، سؤالي هو ، هل يتم فعلاً سحب الصورة من خلال السكانر ( الماسح الضوئي ) ولكن لا يتم عرضها في مربع الصورة ؟؟؟؟

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