د.كاف يار

عند الفتح ضع الكود التالي [رقم شهادة الميلاد].Enabled = False في حدث عند التغيير ضع الكود التالي If [مفترض] = "نعم" Then [رقم شهادة الميلاد].Enabled = True Else [رقم شهادة الميلاد].Enabled = False End If

تفصل التعديل اخي الكريم مثال بصيغتين.rar

تفضل التعديل اخي الكريم DATA12.mdb

اخي الكريم لكي نتمكن من مساعدتك ارفق نموذج من مشروعك للتعديل عليه

تفضل التعديل اخي الكريم سيتم تنبيه المستخدم في حال الاستخدام وصل الى 100 مرة و للاستمرار يجب ادخال مفتاح الترخيص للاستمرار مفتاح الترخيص هو 123 تستطيع التعديل عليه DATA12.mdb

تستطيع عمل جدول تتبع التغييرات مع الاحتفاظ بالقيمة القديمة لكن يبقى طلبك غير واضح

اخي ازهر بصراحة ما فهمت طلبك لكن جرب هذا و عدل حسب حاجتك Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("SELECT * FROM [HUR] WHERE [ID]=[Forms]![fur]![ID];") If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) [ur] = rs.Fields("ID") Wend End If rs.Close Set rs = Nothing

تفضل اخي الكريم بحث بالريكورد ست.accdb

التنسيق يكون كالتالي في حال ان الارقام FORMAT(123456789 ; "##-##-#####")

من الطبيعي ان لا يعمل الاستعلام معك لأن مسار الجدل المرتبط قد تغيير الحل ان تقوم بتعديل الجداول داخل الاستعلام

فتحت الملف و للأسف ما فهمت شي ياليت تشرحي يكون افضل

تفضل هذا المثال تم تطبيق الكود عليه الأساسي.accdb

تفضل هذا التعديل اخي الكريم InvoiceSale_6 (1) (1).accdb

اذا اتفضل هذا التعديل مع مراعاة اضافة اسم التقرير و الفلتر Dim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt) On Error Resume Next BrowseForFolder = ShellApp.self.path On Error GoTo 0 Set ShellApp = Nothing Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Select Dim reportName As String Dim fileName As String Dim criteria As String reportName = "اسم التقرير" fileName = BrowseForFolder & "\" & reportName & ".pdf" criteria = "فلتر SQL" DoCmd.OpenReport reportName, acViewPreview, , criteria, acHidden DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, fileName DoCmd.Close acReport, reportName, acSaveNo Exit Sub Invalid: BrowseForFolder = False

اتفضل هذا التعديل Dim reportName As String Dim fileName As String Dim criteria As String reportName = "اسم التقرير" criteria = "[Image No] = 1 " ' هنا الفلتر DoCmd.OpenReport reportName, acViewPreview, , criteria, "" DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, fileName DoCmd.Close acReport, reportName, acSaveNo

تفضل اخي الكريم مع مراعاة تعديل ما يلزم Dim reportName As String Dim fileName As String Dim criteria As String reportName = "اسم التقرير" fileName = CurrentProject.Path & "\" & " اسم التقرير " & ".pdf" criteria = "[Image No] = 1 " ' هنا الفلتر DoCmd.OpenReport reportName, acViewPreview, , criteria, acHidden DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, fileName DoCmd.Close acReport, reportName, acSaveNo

تضبط مع تحديث الارتباط كما هو موضح

استخدم هذا الكود اخي الكريم Set conn = CreateObject("ADODB.Connection") ' ادخل اسم السيرفر و اسم المستخدم و كلمة المرور conn.Open "DRIVER={SQL Server};SERVER=ServerName;UID=USER;PWD=password;DATABASE=mydatabase" Set rs = CreateObject("ADODB.recordset") Dim MyData As String MyData = "اسم الجدول" Dim usert As String rs.Open "Select * from " & MyData, conn If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) usert = usert & vbNewLine & rs.Fields("[اسم العمود]") rs.MoveNext Wend End If rs.Close Set rs = Nothing MsgBox usert

تفضل اخي الكريم مع تعديل ما يلزم Dim msg1, msg2 As String msg2 = "يجب عدم ترك حقول فارغة للاستمرار" Dim ctl As Control For Each ctl In [اسم النموذج الفرعي].Controls If TypeName(ctl) = "TextBox" Then If IsNull(ctl) Or ctl = "" Or ctl = 0 Then If msg1 = "" Then msg1 = ctl.Name Else msg1 = msg1 & vbNewLine & ctl.Name End If End If End If Next ctl If msg1 = "" Then DoCmd.RunCommand acCmdSaveRecord MsgBox "تم الحفظ بنجاح", vbInformation, "تأكيد" Else MsgBox msg2 & vbNewLine & msg1, vbCritical + vbMsgBoxRight, "تنبيه بوجود حقول فارغة" End If

تفضل التعديل اخي الكريم يجب فك الضغط عن الملفات اولاً تصدير البيانات.zip

تفضل هذه المشاركة اخي الكريم لعلها تحل المشكلة فقط نسخ هذا الكود الصقه في حدث ازرار الحفظ Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT Max(InvoiceNum) FROM InvoiceHT;") InvoiceNum = "A" & Format(Nz(rs.Fields(0), 0) + 1, "1000") rs.Close Set rs = Nothing

اخي الكريم لم افهم طلبك ارجوا ان تضوح ماهو المطلوب و ما الهدف منه حسب فهمي فهو جدول للورديات - عند ادخال موظف في الوردية رقم 1 لا يظهر اسمه في باقي الورديات ؟؟ هل هذا صحيح

اخي الكريم في هذه الحياة ليس كل ما يتمناه المرء يدركه لكن تستطيع ان تدرك ما تتمنى بإسلوب غير مباشر في هذا التعديل لن نقوم بالاستغناء عنصر مصدر السجلات الفرعية فهي أداة لحفظ البيانات الواردة من القاعدة الأخرى لكن في نفس الوقت وضعت لك ازرار لحفظ التعديلات من القاعدة الاساسية الى القاعدة الفرعية Desktop1.zip

تم تطبيق المثال اخي الكريم فقط قم باستخراج الملفات على سطح المكتب و افتح الملف الذي يحمل الاسم " الأساسي " Desktop.zip

اخي الكريم لا تزيل On Error Resume Next الخطأ لأنه انتهت السجلات ارجع و ضيف الأمر On Error Resume Next و راح يعمل معاك