Foksh

وعليكم السلام ورحمة الله وبركاته .. ملاحظة مهمة بخصوص المتغيرين i و ii :- حيث تم تعريفهما كـ String ، بينما من الواضح ( وبناءً على ما أذكر من مشاركات سابقة ) أنهما يمثلان رقم الترم المخزن في العمود الأول (Column(0)) من الـ ComboBox . صحيح ؟؟ Private Sub Report_Open(Cancel As Integer) Dim i As Long, ii As Long i = Forms!frm_Reports!ComboSaf.Column(0) ii = Forms!frm_Reports!termNum.Column(0) Me.tsmya1.Caption = funSanahDrasyahDate() If ii = 2 Then Me.tsmya2.Caption = "الدور الأول" Else Me.tsmya2.Caption = "الدور الثاني" End If DoCmd.Maximize End Sub

وعليكم السلام ورحمة الله وبركاته .. في الورقة "بينات" لاحظ التكرار في القيم لـ CAR على سبيل المثال ، فأي عدد معدات سيتم اعتباره العدد الصحيح للمعدات ؟؟؟ وكذلك الأمر لباقي المطلوب .. وحتى عدد الساعات !!!!!!! فسر لنا بالضبط الشروط والمعايير التي على أساسها سيتم اعتماد القيم الصحيحة لإنشاء معادلاتك !!

نعم صحيح ، يتم التعامل مع الجداول فقط دون الحاجة الى حذفها وإعادة العلاقات اليها .. ما يتم هو حف السجلات بدءً بجداول الأبناء للعلاقات ، ثم حذف السجلات من الجداول الآباء . وعند الإستعادة يتم الأمر بالعكس !! حيث ستكون الإستعادة أولاً لجداول الآباء ثم الأبناء تباعاً ,, التجربة هي الفيصل في الأمر 😅 . حيث قمت بالتجربة على اكثر من مشروع لدي وكان الأمر ناجحاً دون حدوث اي مشاكل ولله الحمد ولإجراءاتكم بالتجربة والإفادة بالنتيجة 😇

مهو انا ما وضعتهوش وقاصد ده .. لأنه لسه في تحديثات جديدة وقلت نشوقكم حبتين

أخي الفاضل ، الجداول مخفية .. انظر الصورة لإظهارها تم ذكر التوضيح في المشاركة الأصلية

وعليكم السلام ورحمة الله وبركاته ،، هذا لأنك لم تنقل جدولي النظام الخاصين بالأداة . USysMyCopies و USysOptCopies

وإياكم أخي الكريم 🤗 😇

العفو أخي الكريم 🤗😇

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أشارككم في هذا الموضوع أداة بسيطة وفعالة قمت بتطويرها لأغراض إنشاء واستعادة نسخ احتياطية من قواعد بيانات اكسيس . ✔️ الهدف الأساسي من الأداة هو توفير طريقة مرنة وآمنة لأخذ نسخ احتياطية من الجداول المهمة بشكل دوري أو عند الحاجة ، وتسهيل استعادتها لاحقاً بنفس البنية والبيانات . صورة من واجهة الأداة :- الواضح من الواجهة ، أن الأداة ستمكنك من :- أولاً :- إنشاء نسخة احتياطية ضمن الإعدادات التي تحددها في زر "خيارات الحفظ" . عند النقر عليه ستجد هذه الإعدادات في الصورة .. مسار الحفظ للنسخ الإحتياطية سيكون فقط في المجلد Backup في المجلد الرئيسي Data الموجود بجانب قاعدة البيانات . نوع الملحق سيكون MDB و DAT . وهما النوعين الأكثر شمولاً واستخداماً في جميع الأفكار التي لها نفس الوظيفة . عدد النسخ التي ستحتفظ بها هو فقط ما تحدده . وسيتم حذف النسخ الأقدم تباعاً . بإمكانك تحديد كلمة مرور لحماية قاعدة بيانات الجداول . ولا ننصح بتغييرها لكل نسخة كي لا تتوه وتفقد بياناتك . إمكانية النسخ التلقائي حسب عدد الأيام أو الساعات الي تريد أخذ نسخة تلقائية فيه . ثانياً :- إنشاء نسخة احتياطية لجداول تقوم بتحديدها - ولك حرية اختيار الجداول في كل نسخة - حيث أنها لن تؤثر على سير عملية الإسترجاع لاحقاً . انظر الصورة للتوضيح :- على اليمين تظهر أسماء الجداول في القاعدة الحالية ( مرتبطة أو محلية ) . ولك الحرية باختيار جداول محددة بالنقر المزدوج على الجدول ، أو تحديد الكل / إلغاء الكل . حسب حاجتك . ثالثاً :- الأزرار كما هي في صورة واجهة الأداة ، تشير إلى :- زر "حفظ نسخة إحتياطية جديدة" :- لإنشاء نسخة إحتياطية حسب الإعدادات اتي تم تحديدها . زر "تحديث بيانات النُسخ الإحتياطية" :- لإعادة ترتيب السجلات في الجدول حسب النسخ الموجودة في مجلد انسخ الإحتياطي . زرا "نُسخ محددة" و "كافة النُسخ" :- لحذف محدد أو لجميع النسخ الإحتياطية . زر "إنشاء" في قسم "نسخة خاصة" :- مخصص لإنشاء نسخة خاصة في مكان يقوم المستخدم بتحديده وليس ضمن المسار المحدد في الإعدادات ، وبإسم متغير كيفما يريد . زر "استرجاع" في قسم "نسخة خاصة" :- مخصص لإسترجاع نسخة يقوم المستخدم بتحديدها بشكل يدوي من خلال مربع حوار اختيار ملف . زر "استرجاع" في قسم "استرجاع النسخة رقم" :- مخصص لاختيار نسخة محددة برقمها . حيث تظهر النسخ التي تم أخذها إحتياطياً ، في أعلى جزء النموذج والتنقل بينها من خلال الزرين < > . رابعاً :- في هذا الإصدار ( V1.0 ) من الأداة على عدم الإعتماد على أي مكتبات خارجية أو من مكتبات أكسيس . حيث تمت التجربة على إصدارات اكسيس ( 2010 فما فوق ) . Backup 2025 - V1.0.accdb.zip :- دائماً يسعدني إبدائكم الرأي والملاحظات حول الأخطاء والمشاكل التي يمكن مواجهتها في أي مشروع يتم تأسيسه في آكسيس أو غيره من لغات البرمجة . أولاً تأكد من وجود جدولي الأداة ( USysMyCopies و USysOptCopies ) عند نسخها الى مشروعك . مع العلم أنها مخفية كجداول نظام ، ويمكنك إظهارها كما في الصورة التالية :- ثانياً ، قم بالدخول الى خيارات الحفظ ، والنقر على زر "انقر لضبط مسار مجلد الحفظ بشكل آلي" لضبط وتحديد مسار مجلد الحفظ الرئيسي . فقط لأول مرة .

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

وعليكم السلام ورحمة الله وبركاته ,, تفضل saffar2.zip

تم نقل مشاركتك الى موضوع جديد

حسناً أخي الكريم ، ولا يهمك .. بسيطة جرب هذا التعديل على قاعدتك التي تحتوي بيانات أكبر ، وتأكد من أخذ نسخة احتياطية منها ( أو نسخة أخرى اعملها للتجربة ) :- Private Sub أمر1069_Click() On Error GoTo ErrorHandler Dim db As DAO.Database Dim rsSource As DAO.Recordset Dim rsDest As DAO.Recordset Dim strSQL As String Dim currentCode As Long DoCmd.SetWarnings False Set db = CurrentDb db.Execute "DELETE FROM tab_degree_mauel", dbFailOnError db.Execute "INSERT INTO tab_degree_mauel(code_fonct, nom_prenom, grade_actuel, categorie, numero_indice_categorie, degre, numero_indice_degre, duree, date_effet, faid_31_12, date_signature_decision, date_reunion_comession, date_calcul_faid_31_12, num_decision) " & _ "SELECT code_fonct, nom_prenom, grade_actuel, categorie, numero_indice_categorie, degre, numero_indice_degre, duree, date_effet, faid_31_12, date_signature_decision, date_reunion_comession, date_calcul_faid_31_12, num_decision " & _ "FROM tab_degree_saisie", dbFailOnError strSQL = "SELECT t1.code_fonct, t1.nom_prenom, t1.degre, t1.numero_indice_degre, t1.date_effet " & _ "FROM tab_degree_saisie t1 " & _ "INNER JOIN (SELECT nom_prenom, MAX(degre) AS MaxDegre " & _ "FROM tab_degree_saisie " & _ "GROUP BY nom_prenom) t2 " & _ "ON t1.nom_prenom = t2.nom_prenom AND t1.degre = t2.MaxDegre" Set rsSource = db.OpenRecordset(strSQL, dbOpenDynaset) If Not (rsSource.EOF And rsSource.BOF) Then rsSource.MoveFirst Do Until rsSource.EOF currentCode = Nz(rsSource!code_fonct, 0) Set rsDest = db.OpenRecordset("SELECT * FROM tbl_info_fonctionnaire WHERE num = " & currentCode, dbOpenDynaset) If rsDest.EOF Then rsDest.AddNew rsDest!num = currentCode Else rsDest.Edit End If rsDest!grade = rsSource!degre rsDest!num_indice_grade = Nz(rsSource!numero_indice_degre, 0) rsDest!date_effet_grade_actuel = Nz(rsSource!date_effet, Date) rsDest.Update rsDest.Close rsSource.MoveNext Loop End If MsgBox "تم تحديث البيانات بنجاح", vbInformation + vbMsgBoxRight, "" Cleanup: On Error Resume Next If Not rsSource Is Nothing Then rsSource.Close Set rsSource = Nothing End If If Not rsDest Is Nothing Then rsDest.Close Set rsDest = Nothing End If Set db = Nothing DoCmd.SetWarnings True Me.Requery Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, "خطأ" Resume Cleanup End Sub

وعليكم السلام ورحمة الله وبركاته ,, هذه محاولة بسيطة قد لا تكون بدقة فكرة الأستاذ @hegazee :- Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, val As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") regex.Pattern = "^\d{1,2}-([a-zA-Z][1-9]\d*|[1-9]\d*[a-zA-Z]?)$" For Each c In Intersect(Target, Columns("E")) If Not IsEmpty(c) Then val = c.Value If Not regex.Test(val) Or Len(val) > 8 Then MsgBox "صيغة غير صحيحة! يجب أن تكون:" & vbCrLf & vbCrLf & _ "تستخدم شرطة (-) فقط (.1)" & vbCrLf & _ "لا تبدأ الأرقام بصفر (.2)" & vbCrLf & _ "لا يوجد صفر بعد الحرف الإنجليزي (.3)" & vbCrLf & _ "(12-a1234 :مثال ) الحد الأقصى 8 أحرف (.4)", _ vbExclamation + vbMsgBoxRight, "تصحيح" Application.Undo End If End If Next c End Sub جربها وأخبرنا بالنتيجة ..

وعليكم السلام ورحمة الله وبركاته ,,, تمام فهمتك ، جرب التعديل ده :- Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, valToCheck As Variant Dim duplicateFound As Boolean Dim lastRow As Long, i As Long On Error Resume Next Set c = Intersect(Target, Columns("E")) If c Is Nothing Then Exit Sub Application.EnableEvents = False valToCheck = c.Value If valToCheck <> "" Then lastRow = Cells(Rows.Count, "E").End(xlUp).Row duplicateFound = False For i = 1 To lastRow If i <> c.Row And Cells(i, "E").Value = valToCheck Then If WorksheetFunction.CountBlank(Range("K" & i & ":N" & i)) = 4 Then MsgBox "الحالة سبق ادخالها ولم يتم بشانها اجراء", vbExclamation + vbMsgBoxRight, "تنبيه" c.ClearContents duplicateFound = True Exit For End If End If Next i If Not duplicateFound Then Cells(c.Row, "D").Value = Date End If End If Application.EnableEvents = True End Sub

انا افتكرت ان الفكرة واضحة ، على العموم اجعل مصدر بيانات النموذج = الجدول trans وحدد لكل كومبوبوكس مكانه في الجدول هذا اذا كنت فاهمك صح طبعاً 😅

وعليكم السلام ورحمة الله وبركاته .. جرب هذه الفكرة أخي الكريم 😊 . Country.zip

وعليكم السلام ورحمة الله وبركاته ,, أخي الكريم ، بداية حتى تبدأ بداية سليمة ، حاول الإبتعاد عن الأسماء العربية لمكونات قاعدة البيانات . وأيضاً استخدام المسافة بين التسميات التي لها أكثر من كلمة .... إلخ من الأساسيات المهمة عند تصميم قواعد البيانات . على العموم .. في حدث قبل التحديث لمربع النص "اسم الصنف" ، استخدم الكود التالي البسيط دون تعقيد .. Private Sub اسم_الصنف_BeforeUpdate(Cancel As Integer) If DCount("*", "[جرد المستودع]", "[اسم الصنف] = '" & Me![اسم الصنف] & "'") > 0 Then MsgBox "هذا الصنف موجود مسبقاً", vbExclamation + vbMsgBoxRight, "": Cancel = True: Me.Undo End If End Sub منع التكرار.zip

الله يبارك فيك يا صديقي .. ونتمنى لكم المزيد من التقدم ان شاء الله ,, بشاااااروووو .. الله يبارك فيك يا قلب .. أخي لطفي ، الله يبارك فيك ، ونتمنى لكم التقدم أيضاً

وعليكم السلام ورحمة الله وبركاته ,, بناءً على ما فهمته من هذا الكم الهائل من المعطيات 😅 ، جرب هذا التعديل ، حيث تم التعديل عى كودك الأصلي ليصبح = Private Sub أمر1069_Click() On Error GoTo ErrorHandler DoCmd.SetWarnings False DoCmd.RunSQL "DELETE FROM tab_degree_mauel" DoCmd.RunSQL "INSERT INTO tab_degree_mauel(code_fonct, nom_prenom, grade_actuel, categorie, numero_indice_categorie, degre, numero_indice_degre, duree, date_effet, faid_31_12, date_signature_decision, date_reunion_comession, date_calcul_faid_31_12, num_decision) " & _ "SELECT code_fonct, nom_prenom, grade_actuel, categorie, numero_indice_categorie, degre, numero_indice_degre, duree, date_effet, faid_31_12, date_signature_decision, date_reunion_comession, date_calcul_faid_31_12, num_decision " & _ "FROM tab_degree_saisie" DoCmd.RunSQL "DELETE FROM tbl_info_fonctionnaire" DoCmd.RunSQL "INSERT INTO tbl_info_fonctionnaire(num, grade, num_indice_grade, date_effet_grade_actuel) " & _ "SELECT code_fonct, degre, numero_indice_degre, date_effet " & _ "FROM tab_degree_saisie t1 " & _ "WHERE degre = (SELECT MAX(degre) FROM tab_degree_saisie t2 WHERE t2.nom_prenom = t1.nom_prenom)" DoCmd.SetWarnings True Me.Requery MsgBox "تم تحديث البيانات في الجدولين بنجاح", vbInformation + vbMsgBoxRight, "تنبيه" Exit Sub ErrorHandler: DoCmd.SetWarnings True MsgBox " : حدث خطأ أثناء تنفيذ العملية " & Err.Description, vbCritical + vbMsgBoxRight, "خطأ" End Sub أخبرنا بالنتيجة baseZ.zip

وعليكم السلام ورحمة الله وبركاته ,, لم اجد الكود الذي تتحدث عنه ،ولكن قم بالتعديل للدالة التي في الملف السابق الى التالي :- Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, valToCheck, foundCell As Range Dim duplicateFound As Boolean On Error Resume Next Set c = Intersect(Target, Columns("E")) If c Is Nothing Then Exit Sub Application.EnableEvents = False valToCheck = c.Value If valToCheck <> "" Then Set foundCell = Columns("E").Find(valToCheck, LookIn:=xlValues) If Not foundCell Is Nothing And foundCell.Row <> c.Row Then If WorksheetFunction.CountBlank(Range("K" & foundCell.Row & ":N" & foundCell.Row)) = 4 Then MsgBox "الحالة سبق ادخالها ولم يتم بشانها اجراء", vbExclamation + vbMsgBoxRight, "تنبيه" c.ClearContents duplicateFound = True End If End If If Not duplicateFound Then Cells(c.Row, "D").Value = Date End If End If Application.EnableEvents = True End Sub وأخبرني بالنتيجة

بسيطة أخي الكريم .. تم التعديل الى الكود التالي :- Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Sheets(ListBox1.Column(0)).Activate Cells.Interior.Pattern = xlNone With Range(ListBox1.Column(1)).EntireRow .Interior.Color = vbYellow .Cells(1, 1).Activate End With TextBox2.Value = ListBox1.Column(2) End Sub

وعليكم السلام ورحمة الله وبركاته .. كفكرة بسيطة ، جرب تعديل هذا الحدث :- Private Sub ListBox1_Click() Sheets(ListBox1.Column(0)).Activate Range(ListBox1.Column(1)).EntireRow.Select TextBox2.Value = ListBox1.Column(2) End Sub الى التعديل التالي :- Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Sheets(ListBox1.Column(0)).Activate Cells.Interior.Pattern = xlNone With Range(ListBox1.Column(1)) .Interior.Color = vbYellow .Activate End With TextBox2.Value = ListBox1.Column(2) End Sub قمت باختيار اللون الأصفر كمثال ، ولك الحرية بالتعديل على مزاجك

إما بإعادة تثبيت نسخة ويندوز 11 بتحديثات جديدة ، أو العودة الى الإصدار السابق ( ويندوز 10 ) ..

ما هو اصدار الأوفيس الذي تستخدمه بعد التحديث ؟؟