محمد أبوعبدالله

وعليكم السلام ورحمة الله وبركاته استبدال السطر التالي Name oldpathANDname As newpathANDname بهذا FileCopy oldpathANDname, newpathANDname 001.rar تحياتي

تفضل اخي الكريم الفكرة : تم انشاء استعلام الحاق بمعيار حقل id المحدد في النموذج تعديل.rar تحياتي

تفضل اخي الكريم تعديل.rar تحياتي

بالاضافة الى ما تفضل به اخونا الفال @ازهر عبد العزيز عبد العزيز وله الشكر لمعاينة النموذج مع فلتر Id DoCmd.OpenForm "aganisttt", , , "ID=" & Me.ID تحياتي

بالاضافة الى ما تفضل به اخونا الفال @ازهر عبد العزيز وله الشكر لمعاينة التقرير مع فلتر Id المريض DoCmd.OpenReport "we1", acViewPreview, , "id = " & Me.id DoCmd.OpenReport "we2", acViewPreview, , "id = " & Me.id تحياتي

بالاضافة الى ما تفضل به استاذنا الفاضل @أبو إبراهيم الغامدي تفضل احي الكريم تحياتي

بالتوفيق اخي الكريم تحياتي

اخي الكريمدعنا نتفق اولاً على تغيير اسم الحقل name الى اي اسم اخرمثلاً txtname واليك كود انشاء مجلد داخل مجلد Dim fs, cf, strFolder, strFolder1 strFolder = CurrentProject.Path & "\" & Me.id.Value strFolder1 = CurrentProject.Path & "\" & Me.id.Value & "\" & Me.txtname.Value Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) End If If fs.FolderExists(strFolder1) = False Then Set cf = fs.CreateFolder(strFolder1) End If تحياتي

المشكلة قي انك تضع القيمة الافتراضية لحقل "عدد" =[Forms]![Names Record]![رقم الملف] والصحيح ان تكون =[Forms]![Names Record]![عدد] sss.rar تحياتي

ما اسم الخلية ؟ تحياتي

اخي الكريم تمت الاجابة عن سؤالك في موضوع سابق فهل توجد مشكلة في الكود Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\" & Me.ID.Value Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) If fs.FolderExists(strFolder) = True Then Else MsgBox "تحذير لم يتم انشاء مجلد المرفقات ", vbExclamation End If End If تحياتي

تفضل اخي الكريم تم ربط جميع الجداول بجدول Names Record عن طريق حفل ( عدد ) - علاقة رأس باطراف وتم التعديل على جدول Names Record بحيث لا يكرر الحقول الهامة ( الاسم - الرقم العام - رقم الملف - السجل المدني ) sss.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم تحياتي

السلام عليكم مرحبا اخي الكريم انت تحتاج الى ضبط العلاقات وهذا شىء هام جدا جدا جدا قمت بعمل جزء من التعديل وارجو ان تكمل على بنفس الطريقة انت لا تحتاج الى جدول Names Record في نموذج Form-dawarat وان احتجته فلا بد من ضبط العلاقة اولاً جرب المرفق واستكمل التعديلان واعلمني بالنتيجة ولو احتجت شىء بالخدمة اخي الكريم sss.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تصفير جميع السجلات ( وضع صفر لحقل chkdays ) DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE tblNumbers SET tblNumbers.chkdays = 0;" DoCmd.SetWarnings True ثم نحدد الارقام الفردية لوضع قيمة -1 لها mySQL = "Select * From tblNumbers WHERE [MyNumber] MOD 2 = 1" تنفيذ الامر For i = 1 To rst.RecordCount rst.Edit rst![chkdays] = -1 rst.Update rst.MoveNext Next الكود كامل DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE tblNumbers SET tblNumbers.chkdays = 0;" DoCmd.SetWarnings True Dim mySQL As String Dim rst As Recordset Dim i As Double mySQL = "Select * From tblNumbers WHERE [MyNumber] MOD 2 = 1" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst For i = 1 To rst.RecordCount rst.Edit rst![chkdays] = -1 rst.Update rst.MoveNext Next TestDB.rar تحياتي

استبدل ' FileCopy SourceFile, DestinationFile بهذا الكود Dim Fpathz As Variant Fpathz = .SelectedItems(1) Dim DBwithEXT, DBwithoutEXT As String DBwithEXT = Dir(Fpathz) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4) FileCopy Fpathz, Application.CurrentProject.Path & "\photo\" & DBwithoutEXT & [imgNo] & Right(DBwithEXT, 4) mmm.rar ملاحظة : انت استبدلت الكود كلياً ولم تستخدم الطلبات التي ذكرتها في المشاركة الاولى تحياتي

تحياتي

بالتوفيق اخي الكريم تحياتي

اخي الكريم يمكنك ان تختار اكثر من ملف بتغيير القيمة .AllowMultiSelect = False الى .AllowMultiSelect = True ولكن المشكلة ليس في ذلك المشكلة في تخزين القيمة في txtFile ونسخ هذه الملفات الى مجلد ال ID فانت امامك خيارين اما ان تضع اكثر من حقل كما اخبرتك في الطريقة السابقة او ان تنشىئ جدول جديد للمرفقات وتضع كل اختيار في سجل ثم نسخ هذه الملفات الى مجلد ID واعتقد ان هذه الطريقة بها شغل كثير ويمكنك الاستفادة من هذه المشاركة ستفيدك جدا ان شاء الله تحياتي

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

تفضل اخي الكريم تحياتي

تحياتي

لانشاء مجلد برقم ID نستخدم الكود التالي Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\" & Me.ID.Value Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) If fs.FolderExists(strFolder) = True Then Else MsgBox "تحذير لم يتم انشاء مجلد المرفقات ", vbExclamation End If End If ولنسخ الملف بنفس الصيغة الى مجلد ID الي تم انشاءه نستخدم الكود التالي Dim Fpathz As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Add "All Files", "*.*" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then Fpathz = .SelectedItems(1) Dim DBwithEXT, DBwithoutEXT As String DBwithEXT = Dir(Fpathz) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4) FileCopy Fpathz, Application.CurrentProject.Path & "\" & Me.ID.Value & "\" & DBwithoutEXT & [ID] & Right(DBwithEXT, 4) Me.txtFile = Application.CurrentProject.Path & "\" & Me.ID.Value & "\" & DBwithoutEXT & [ID] & Right(DBwithEXT, 4) End If End With واذا اردت ارفق اكثر من ملف فضع اولا اكثر من حقل لارفاق الملف به مثال ( صورة البطاقة - صورة جواز السفر ... وهكذا ) بالمناسبة قمت بتعديل اسماء الحقول فلديك مثلا حقل باسم name وهذه التسمية خطأ فيجب تغيره لانه محجوز من access Database1.rar تحياتي

بالتوفيق اخي الكريم تحياتي

تفضل اخي الكريم Dim T_Export As String ' T_Export = "SELECT * FROM Table1 WHERE [name] LIKE '*" & Me.Combo7 & "*'" ' T_Export = "SELECT * FROM Table1 WHERE [nam2] LIKE '*" & Me.Combo2 & "*'" T_Export = "SELECT * FROM Table1 WHERE [name] LIKE '*" & Me.Combo7 & "*' And [nam2] LIKE '*" & Me.Combo2 & "*' And [name3] LIKE '*" & Me.Combo3 & "*'" Set T_Query = CurrentDb.CreateQueryDef("tQueryDef", T_Export) DoCmd.OutputTo acOutputQuery, "tQueryDef", acFormatXLS, CurrentProject.Path & "\Query1.xls", True CurrentDb.QueryDefs.Delete T_Query.name id.rar تحياتي