ابو جودي

مش عارف انا عارف افهمك واللا لاء جرب استخدام الاكواد التاليه Sub DuplicateRecords() Dim db As DAO.Database Dim rs As DAO.Recordset Dim newPCode As Long Dim todayDate As Date Dim sqlInsertLab As String Dim sqlInsertRequest As String Dim sqlInsertTests As String ' فتح قاعدة البيانات الحالية Set db = CurrentDb() todayDate = Date ' جلب آخر PCode من جدول tbl_NewLab لتجنب التكرار Set rs = db.OpenRecordset("SELECT MAX(PCode) AS MaxPCode FROM tbl_NewLab") If Not rs.EOF Then newPCode = rs!MaxPCode + 1 Else newPCode = 1 ' في حالة عدم وجود سجلات End If rs.Close ' استبدال المرجع بالصيغة الصحيحة Dim currentPCode As Long currentPCode = Forms!New_Project!newRequest.Form!PCode ' إدراج السجل الجديد في tbl_NewLab sqlInsertLab = "INSERT INTO tbl_NewLab (DDate, PCode, Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year) " & _ "SELECT #" & todayDate & "#, " & newPCode & ", Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year " & _ "FROM tbl_NewLab WHERE PCode = " & currentPCode db.Execute sqlInsertLab ' إدراج السجل الجديد في tbl_NewRequest sqlInsertRequest = "INSERT INTO tbl_NewRequest (PCode, TCode, Date_R, Price_R, Tname_R) " & _ "SELECT " & newPCode & ", TCode, #" & todayDate & "#, Price_R, Tname_R " & _ "FROM tbl_NewRequest WHERE PCode = " & currentPCode db.Execute sqlInsertRequest ' إدراج السجل الجديد في tbl_NewTests (إذا لزم الأمر) sqlInsertTests = "INSERT INTO tbl_NewTests (TCode, TName, Price) " & _ "SELECT TCode, TName, Price " & _ "FROM tbl_NewTests WHERE TCode IN (SELECT TCode FROM tbl_NewRequest WHERE PCode = " & currentPCode & ")" db.Execute sqlInsertTests MsgBox "تم تكرار السجل بنجاح مع تحديث PCode والتاريخ.", vbInformation End Sub Private Sub أمر4030_Click() DuplicateRecords End Sub

جرب الكود التالى Public Function DivideIntoColumns(totalNumber As Integer, columnIndex As Integer) As Integer Static result(1 To 6) As Integer Static lastNumber As Integer Dim remaining As Integer Dim i As Integer Dim randNum As Integer ' حدود الأعمدة Dim maxLimits(1 To 6) As Integer maxLimits(1) = 20 maxLimits(2) = 20 maxLimits(3) = 20 maxLimits(4) = 20 maxLimits(5) = 10 maxLimits(6) = 5 ' Reset results if the input number changes If lastNumber <> totalNumber Then lastNumber = totalNumber remaining = totalNumber ' Initialize the result array to zero For i = 1 To 6 result(i) = 0 Next i ' Step 1: Ensure each column has at least 2 For i = 1 To 6 If remaining >= 2 Then result(i) = 2 remaining = remaining - 2 End If Next i ' Step 2: Distribute remaining values randomly while respecting max limits Randomize While remaining > 0 i = Int((6) * Rnd) + 1 ' Random column (1 to 6) ' Check if the column can accept more values without exceeding its max limit If result(i) < maxLimits(i) Then randNum = IIf(remaining > maxLimits(i) - result(i), maxLimits(i) - result(i), remaining) result(i) = result(i) + randNum remaining = remaining - randNum End If Wend End If ' Return the value for the requested column DivideIntoColumns = result(columnIndex) End Function والاستعلام سوف يكون بناء على الكود كالتالى SELECT Table1.MyNum, DivideIntoColumns([MyNum],1) AS Col1, DivideIntoColumns([MyNum],2) AS Col2, DivideIntoColumns([MyNum],3) AS Col3, DivideIntoColumns([MyNum],4) AS Col4, DivideIntoColumns([MyNum],5) AS Col5, DivideIntoColumns([MyNum],6) AS Col6 FROM Table1;

هههههههه انا حسيت ان فى شئ غير صحيح وكنت استحى ان اذكر ذلك توقعت اننى المخطئ فى فهمى

اعرف انه لم يعط نتيجه انا بصراحة لم افهم منطق النتيجة ممكن اتقل على حضرتك ومن واقع النتيجة بالجدولين والاستعلام Query1 حضرتك تقول لى ايه اللى المفروض يحصل بناء على رغبتك بالقيم المفروض النتيجة هنا تكون ايه طيب Table1 ID userID chek1 1 aa 1 2 aa 1 3 cc 1 4 cc 1 5 gg 1 لان دى نتيجة الاستعلام Query1 user_ID p1 p2 pp aa 40 30 10 bb 60 60 0 gg 40 25 15 الاستعلام يوضح ان القيمة bb للحقل user_ID وهو حقل الربط اللى حضرتك عاوز تستخدمه فى استعلام التحديث هى التى تحقق معها الشرط فى الحقل PP = 0 طيب بما ان user_ID قيمته كات عند تحقيق الشرط هى : bb اين هذه القيمه القيمه فى الجدول Table1 بالنسبة للحقل الربط : userID المستخدم فى الربط فى استعلام التحديث لذلك الاستعلام الفرعى لم يعط اى نتائج ولكن لو كانت القيمة موجودة لعمل الاستعلام هذا ما فهمته انا من التحليل

استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل اعتقد لا يمكن عمل ذلك فان الاستعلام Query1 غير قابل للتحديث لانه يحتوى على دوال تجميع SUM بدلاً من استخدام Query1 مباشرة في عملية التحديث اعتقد لو كنت قدرت افهم صح ممكن استخدام استعلام فرعي (Subquery) داخل جملة التحديث بشكل مباشر UPDATE Table1 SET Table1.chek1 = 0 WHERE Table1.userID IN ( SELECT Table2.user_ID FROM Table2 GROUP BY Table2.user_ID HAVING CLng(Sum(Table2.price1)) - CLng(Sum(Table2.price2)) = 0 );

اتفضل dodo - 3.zip

وده المرفق للتطبيق ومعاك فكرتين الاولى التى تعتمد على الاكواد والثانية التى تعتمد على الاستعلام dodo - 2.zip

وممكن كده برضو SELECT student.id_stu, student.name, student.saf_id, student.totale, student.galose, student.fasle, student.birth, Tbl_saf.saf_id, Tbl_saf.saf FROM student INNER JOIN Tbl_saf ON student.saf_id = Tbl_saf.saf_id WHERE student.saf_id = [Forms]![form1]![cc] AND (SELECT COUNT(*) FROM student AS s2 WHERE s2.saf_id = student.saf_id AND (s2.totale > student.totale OR (s2.totale = student.totale AND s2.birth < student.birth) OR (s2.totale = student.totale AND s2.birth = student.birth AND s2.name < student.name)) ) < 10 ORDER BY student.saf_id, student.totale DESC , student.birth, student.name;

السلام عليكم ورحمة الله تعالى وبركاته يواجه الكثير من المصممين مشكلة اختلاف اللغة او بمعنى ادق يريد الكثير ان تكون لغة الازرار والتطبيق والرسائل موحدة وهذا ما لا يحدث عندما تكون نسخة الويندوز مثلا انجليزية والتطبيق بمصمم باللغة العربية او حتى يكون التعبير اكثر دقه عندما تختلف لغة واجهة المستخدم فى الويندوز عن اللغة التى يريد المصمم ان تظهر بها كل كبيرة وصغيرة قى التطبيق بما فيها ازرار الرسائل مثال لكى تكون الصورة اكثر وضوحا الرسالة بالعربى وهنا يريد المصمم ان تكون لغة الازرار كذلك بالعربى ولكن لغة واجهة الاستخدام انجليزية وعنوان الزر يظهر تبعا للغة الويندوز تم التغلب عليها مسبقا باستخدام دوال الـ API ولست بصدد الحديث عنها لان بها قيد وهو - شرط لان يتم تغيير اسماء الازرار فى صندوق الرسائل بالاسماء التى يرغب بها المستخدم ان تكوت الخصيصة pop up للنموج = No وهذا فيه تقييد للمصمم وخاصة ان كان يستخدم هذه الخصيصة بالشكل التالى pop up للنموج = Yes وكان الحل البديل هو عمل نموذج للرسائل بدلا من استخدام صندوق الرسائل واعتقد تم عمل ذلك مسبقا فى المنتدى ولكن انا الان اقدمه بافضل اسلوب احترافى واكثر مرونه. لعمل ذلك اولا قم بتصميم نموذج للرسائل واعطه الاسم : frmCustomMessageBox وان اردت تغيير الاسم قم بالتسمية التى تناسبك مع مراعاة تغيير الاسم كذلك فى الكود الذى سوف اقدمه بعد قليل والمستخدم فى الوحدة النمطية العامة الان افتح نموذج الرسائل "frmCustomMessageBox" فى وضع التصميم اضف العناصر التاليه عدد 5 عنصر "Buttons" أزرار أوامر على ان تكون الاسماء للازرار كالتالى : Button0 , Button1 , Button2 , Button3 , Button4 عدد 1 عنصر "Labels" عنوان : على ان يكون اسمه كالتالى : MessageLabel عدد 1 عنصر "Image" صورة : على ان يكون اسمه كالتالى : IconImage والان اضف وحدة نمطية عامة واعطها مثلا الاسم : basCustomMessageBox اضف اليها الكود التالى ' متغير لتخزين رقم الزر الذي تم الضغط عليه في نموذج الرسائل المخصص. Private intPressedButton As Integer ' دالة لعرض صندوق رسائل مخصص ' Parameters: ' - arrMessageLines: مصفوفة تحتوي على أسطر الرسالة. ' - strTitle: عنوان صندوق الرسائل. ' - strButtons: قائمة أزرار مفصولة بفواصل. ' - arrTooltips: مصفوفة تحتوي على تلميحات للأزرار (اختياري). ' - strIconPath: مسار الأيقونة (اختياري). ' Returns: ' - رقم الزر الذي تم الضغط عليه (بدءًا من 0 إلى 4)، أو -1 في حالة حدوث خطأ. Function MsgBx(arrMessageLines As Variant, strTitle As String, strButtons As String, Optional arrTooltips As Variant = Null, Optional strIconPath As String = "") As Integer On Error GoTo ErrorHandler Dim frmCustomMsgBox As Form Dim ctrlCurrent As Control Dim strButtonCaption As Variant Dim intButtonIndex As Integer Dim arrButtonCaptions As Variant Dim strMessage As String Dim strLine As Variant Dim strFormName As String strFormName = "frmCustomMessageBox" ' بناء الرسالة من الأسطر الممررة strMessage = "" For Each strLine In arrMessageLines If strMessage <> "" Then strMessage = strMessage & vbCrLf ' إضافة سطر جديد بين الأسطر End If strMessage = strMessage & strLine Next strLine ' التحقق إذا كان النموذج مفتوحًا If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> 0 Then ' إذا كان النموذج مفتوحًا، فقط استعد المرجع إليه Set frmCustomMsgBox = Forms(strFormName) Else ' إذا لم يكن مفتوحًا، افتحه DoCmd.OpenForm strFormName, acNormal, , , , acHidden Set frmCustomMsgBox = Forms(strFormName) End If ' إعداد خصائص النموذج With frmCustomMsgBox .Caption = strTitle .Controls("MessageLabel").Caption = strMessage ' إظهار التسمية فقط إذا كان هناك نص .Controls("MessageLabel").Visible = (strMessage <> "") ' إضافة الأزرار الجديدة بناءً على strButtons intButtonIndex = 0 arrButtonCaptions = Split(strButtons, ",") For Each strButtonCaption In arrButtonCaptions With .Controls("Button" & intButtonIndex) .Caption = strButtonCaption .Visible = True .OnClick = "=PressedButton(" & intButtonIndex & ")" ' تعيين التلميحات للأزرار إذا تم تمريرها If Not IsNull(arrTooltips) And IsArray(arrTooltips) Then If intButtonIndex <= UBound(arrTooltips) Then .ControlTipText = arrTooltips(intButtonIndex) End If End If End With intButtonIndex = intButtonIndex + 1 Next strButtonCaption ' تعيين الأيقونة إذا كان مسارها موجودًا If strIconPath <> "" Then If Dir(strIconPath) <> "" Then ' إذا كانت الأيقونة موجودة، قم بتعيينها On Error Resume Next ' تجاهل الخطأ إذا حدث .Controls("IconImage").Picture = strIconPath If Err.Number <> 0 Then ' إذا حدث خطأ، أخفي عنصر التحكم .Controls("IconImage").Visible = False Err.Clear Else .Controls("IconImage").Visible = True End If On Error GoTo ErrorHandler ' العودة إلى إدارة الأخطاء العادية Else ' إذا لم تكن الأيقونة موجودة، أخفي عنصر التحكم .Controls("IconImage").Visible = False End If Else ' إذا لم يتم تمرير أيقونة، أخفي عنصر التحكم .Controls("IconImage").Visible = False End If End With ' إظهار النموذج كمودال DoCmd.OpenForm strFormName, acNormal intPressedButton = -1 ' انتظار المستخدم لتحديد زر Do DoEvents Loop Until intPressedButton > -1 ' إرجاع القيمة وإغلاق النموذج DoCmd.Close acForm, strFormName, acSaveNo MsgBx = intPressedButton Exit Function ErrorHandler: ' إرجاع قيمة تشير إلى فشل العملية MsgBx = -1 MsgBox "حدث خطأ: " & Err.Number & " | " & Err.Description Debug.Print "حدث خطأ: " & Err.Number & " | " & Err.Description Exit Function End Function Function PressedButton(intButtonIndex As Integer) ' تسجيل الرقم الخاص بالزر المضغوط intPressedButton = intButtonIndex End Function والان طريقة الاستدعاء من اى زر امر لهواة الاختصار فى الاكواد من اى نموذج تكون كالتالى ' تعريف متغير لتخزين نتيجة اختيار المستخدم من النافذة المنبثقة Dim Result As Integer Result = MsgBx(Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟"), "تحذير", "نعم,لا", Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء"), "Full-Path\error.png") If Result = 0 Then MsgBox "تم اختيار موافق" ElseIf Result = 1 Then MsgBox "تم اختيار إلغاء" End If ولكن الطريقة الأمثل لسهولة التعديل والاضافة والصيانة فى المستقبل يكون الاستدعاء بالشكل التالى ' تعريف المتغيرات المستخدمة Dim MessageLines As Variant ' تخزين سطور الرسالة (نص رئيسي وفرعي) Dim TitleText As String ' عنوان النافذة المنبثقة Dim ButtonsText As String ' نص الأزرار (مفصولة بفواصل) Dim Result As Integer ' نتيجة اختيار المستخدم Dim IconPath As String ' مسار ملف أيقونة التحذير Dim Tooltips As Variant ' تلميحات توضيحية عند التمرير على الأزرار ' تعيين مسار ملف الأيقونة التحذيرية (يجب التأكد من صحة المسار) IconPath = "Full-Path\error.png" ' تهيئة محتوى الرسالة: MessageLines = Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟") TitleText = "تحذير" ' عنوان النافذة المنبثقة ButtonsText = "نعم,لا" ' خيارات الأزرار (الزر الأول: نعم، الزر الثاني: لا) ' تعيين التلميحات التوضيحية عند تمرير الماوس على الأزرار: ' تلميح للزر الأول (نعم) ' تلميح للزر الثاني (لا) Tooltips = Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء") ' استدعاء الدالة المخصصة لعرض الرسالة: ' محتوى الرسالة -العنوان - اسماء الأزرار - التلميحات - مسار الأيقونة Result = MsgBx(MessageLines, TitleText, ButtonsText, Tooltips, IconPath) ' معالجة النتيجة المرجعة من الدالة: If Result = -1 Then ' حالة الخطأ (-1 تعني فشل في عرض الرسالة) MsgBox "حدث خطأ أثناء عرض الرسالة." ElseIf Result = 0 Then ' الزر الأول (نعم) تم اختياره MsgBox "تم اختيار نعم" ElseIf Result = 1 Then ' الزر الثاني (لا) تم اختياره MsgBox "تم اختيار لا" End If لتكون النتيجة كما بالشكل التالى من النموج بدلا من صندوق الرسائل التقليدى طبعا يمكن تغيير اسماء الازرار عند الاستدعاء من السطر : ButtonsText = "نعم, لا" ليكون مثلا ButtonsText = "موافق , الغاء" وطبعا تغير السطر : MsgBox "تم اختيار نعم" باضافة الكود الذى تريده عند الضغط على الزر انا فقط كتبت الرسالة فى كود الاستدعاء لتوضيح انه سوف يتم تنفيذ الامر ملحوظة : استخدام : Tooltips وهو التلميح عندما يحوم الماوس فوق الازرار فى النموذج اختيارى ممكن عدم استخدامه كذلك استخدام : IconPath وهو مسار لصورة ايقونة تدل على الرسالة اختيارى ممكن عدم استخدامه ولكن طبعا انا كتبت الكود بحيث يوفر اكبر قدر ممكن من المرونه فى تناول او عدم تناول هذه الخصائص لمن يريد تغيير الايقونات مع كل رسالة او تغيير عدد او اسماء الازرار مع كل رسالة وكذلك التلميحات للازرار المستخدمه ملاحطة هامة جدا جدا جدا : لا تنسي اخفاء كل ازرار الاوامر الخمسة فى النموذج الكود سوف يقوم بإعادة اظهار الازرار حسب الاستدعاء تحياتى الحارة CustomMessageBox.zip

دى فكرتى فى وحدة نمطيه عامة نضع الكود التالى Public Sub SplitNationalID(formOrReport As Object, nationalID As String) Dim i As Integer Dim ctrl As Control ' التأكد من أن الرقم القومي يحتوي على 14 رقمًا If Len(nationalID) <> 14 Then MsgBox "الرقم القومي يجب أن يتكون من 14 رقمًا!", vbExclamation Exit Sub End If ' فصل الرقم القومي إلى أرقام فردية وتعيينها إلى مربعات النص For Each ctrl In formOrReport.Controls If TypeName(ctrl) = "TextBox" And Left(ctrl.Name, 3) = "txt" Then i = Val(Mid(ctrl.Name, 4)) ' استخراج الرقم من اسم مربع النص (مثل txt1, txt2, إلخ) If i >= 1 And i <= 14 Then ctrl.Value = Mid(nationalID, i, 1) End If End If Next ctrl End Sub على ان يكون فى النموذج عدد 15 مربع النص مربع النص الاول يكون باسم : txtNationalID والباقى تكون اسمائهم txt1 الى txt14 وزر امر عند الضغط عليه يتم استدعاء الدالة بالشكل التالى SplitNationalID Me, Me.txtNationalID.Value ونفس الموضوع للتقرير على ان يتم الاستدعاء عند الفتح وانا اكتب انت تضع المرفق لا وبتفكر زى افكار بس انا فكرتى اكثر مرونه منك 😛😄

ايه ده مش ممكن نفكر بمرونه شويه يا ناس ؟ افضل انا اكتب اسماء ال 14 مربع نص فاضى انا بقه صح طبعا امزح مع استاذى و معلمى الاستاذ القدير @AlwaZeeR

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

ممكن كتابة الكود التالى فى ملف Text ثم بعد ذلك حفظ الملف باسم : UnblockDatabase.ps1 حتى يكون الملف الناتج عبارة عن ملف : PowerShell ويتم تشعيل الملف كمسئول وظيفة الكود الدوران على قواعد البيانات الموجوده فى المجلد الحالى او المجلدات الفرعيه للمجلد الحالى وازالة الحظر لهذه القواعد واقصد بالحظر هنا الموجودة بالصورة التاليه # التحقق من صلاحيات المسؤول if (-not ([Security.Principal.WindowsPrincipal] [Security.Principal.WindowsIdentity]::GetCurrent()).IsInRole([Security.Principal.WindowsBuiltInRole] "Administrator")) { Write-Host "❌ يجب تشغيل السكربت بصلاحيات المسؤول لتعيين سياسة التنفيذ." exit } # تعيين سياسة التنفيذ Set-ExecutionPolicy -Scope LocalMachine -ExecutionPolicy RemoteSigned -Force Write-Host "✅ تم تعيين سياسة التنفيذ إلى RemoteSigned على مستوى الجهاز." # الحصول على المسار الحالي للمجلد الذي يحتوي على الكود $currentFolder = $PSScriptRoot # البحث عن جميع ملفات قواعد البيانات (مثل *.accdb و *.mdb) في المجلد الحالي والمجلدات الفرعية $databaseFiles = Get-ChildItem -Path $currentFolder -Include *.accdb, *.mdb -Recurse # التحقق من وجود ملفات قاعدة البيانات if ($databaseFiles) { foreach ($file in $databaseFiles) { try { # إزالة الحظر من الملف $zoneIdentifier = "$($file.FullName):Zone.Identifier" if (Test-Path $zoneIdentifier) { Remove-Item -Path $zoneIdentifier -Force Write-Host "تم إزالة الحظر من الملف: $($file.FullName)" } else { Write-Host "الملف غير محظور: $($file.FullName)" } } catch { Write-Host "حدث خطأ أثناء محاولة إزالة الحظر من الملف: $($file.FullName) - $_" } } } else { Write-Host "لم يتم العثور على ملفات قاعدة بيانات في المجلد الحالي." } UnblockDatabase.zip

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

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

للاسف اعتقد انه شئ من اتنين ترفع القاعدة هنا ونحولها لك او تقوم بتصطيب اوفيس 2007 او احدث

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

طيب ودى فكرتى test(2).accdb

من خلال الاكسس نفسه اعمل حفظ باسم واختر ما تريد مثل

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

اتفضل Database9.accdb

انا الان بت حريصا على استخدام التالى : تشفير كلمة المرور : HashPasswordSHA256 استخدام المعلمات عن طريق : QueryDef هل هذا كافى يا استاذ @شايب لتجنب مثل هذه الهجمات والاختراقات المتقدمه الممكنة كود تشفير كلمات المرور بالشكل التالى Public Function HashPasswordSHA256(ByVal Password As String) As String Dim xmlObj As Object Dim bytes() As Byte Dim hash() As Byte Dim i As Integer Dim result As String ' استخدام كائن MSXML2 Set xmlObj = CreateObject("System.Security.Cryptography.SHA256Managed") ' تحويل النص إلى مصفوفة بايتات bytes = StrConv(Password, vbFromUnicode) ' حساب التجزئة hash = xmlObj.ComputeHash_2(bytes) ' تحويل النتيجة إلى سلسلة نصوص For i = LBound(hash) To UBound(hash) result = result & LCase(Right("0" & Hex(hash(i)), 2)) Next i ' إعادة النتيجة النهائية HashPasswordSHA256 = result ' تنظيف الموارد Set xmlObj = Nothing End Function اما بخصوص استخدام المعلمات عن طريق : QueryDef هذا شكل الاستعلام للتحقق من البيانات Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim rst As DAO.Recordset Dim strSQL As String ' SQL مع معلمات strSQL = "SELECT UserName, IsActive FROM Users WHERE UserName = [paramUserName] AND Password = [paramPassword]" ' إعداد قاعدة البيانات وإنشاء QueryDef Set db = CurrentDb Set qdf = db.CreateQueryDef("", strSQL) ' تعيين القيم للمعلمات qdf.Parameters("paramUserName").Value = Me.UserNametxt qdf.Parameters("paramPassword").Value = Me.Passwordtxt

تقصد : SQL Injection

السلام عليكم ورحمة الله وبركاته استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل ممكن نكتب الكود بالشكل ده ليكون دالة واحدة فقط ' دالة لتطبيق الإعدادات على النماذج والتقارير Public Sub ApplySettingsToAllObjects() Dim obj As Object On Error Resume Next ' تجاهل الأخطاء لتجنب توقف الكود ' تطبيق الإعدادات على النماذج For Each obj In CurrentProject.AllForms DoCmd.openForm obj.Name, acDesign Forms(obj.Name).PopUp = True Forms(obj.Name).Modal = True Forms(obj.Name).ShortcutMenu = False DoCmd.Close acForm, obj.Name, acSaveYes Next ' تطبيق الإعدادات على التقارير For Each obj In CurrentProject.AllReports DoCmd.openReport obj.Name, acDesign Reports(obj.Name).PopUp = True Reports(obj.Name).Modal = True Reports(obj.Name).ShortcutMenuBar = "cmb_Copy_Sort_Filter" ' قائمة استاذنا جعفر المختصرة DoCmd.Close acReport, obj.Name, acSaveYes Next On Error GoTo 0 ' إعادة تفعيل التعامل مع الأخطاء MsgBox "تم تطبيق الإعدادات على جميع النماذج والتقارير بنجاح!", vbInformation End Sub وزيادة فى الخير واثراء للموضوع هذا الموضوع ايضا لاشرطة الاوامر المختصرة

الافضل استخدام نموذج غير منضم او حقول غير منضمه داخل النموذج المنضم مرفق للتجربة baseF222 .accdb