Foksh

اخي الكريم @اشرف السيد يوسف ، قم بما يلي :-
انشئ استعلام وقم باختيار الجدول Table1 ، ثم قم بإضافة جميع الحقول ( الاسم ، العمل1 ، العمل 2 ..... إلخ ) . ثم اعمل تجميع واجعل جميع الحقول MAX باستثناء حقل الاسم اتركه Group By.
 
وهذا مثالك أيضاً  مرفق.accdb  🤗

طريقتك في بناء التقرير والاستعلامات اعتقد تحتاج الى اعادة هيكلة للحصول على النتيجة المطلوبة .

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

لحد ما فهمت الدنيا عاملة ازاي في الملف قدرت اوصل للمطلوب 😅
في النموذج NewPU > في الزرار U حط الكود ده
Private Sub U_Click() DoCmd.OpenForm "newPara", , , "[Pcode]=" & Me.PCode If Me.TN.Caption = "Urine" Then Forms![newpara].Urine.SetFocus Forms![newpara]!Normal.SetFocus ElseIf Me.TN.Caption = "Creat" Then Forms![newpara].Chemistry.SetFocus DoCmd.GoToControl "Creat_Print" ElseIf Me.TN.Caption = "Lipids" Then Forms![newpara]!Cholesterol.SetFocus ElseIf Me.TN.Caption = "Liver" Then Forms![newpara]!ALT(SGPT).SetFocus End If End Sub  

لأ يا صديقي ، من قائمة File ثم Save As
واختر التنسيق 2003 مثلا أو 2007 ان كان موجوداً 
الحمد لله رب العالمين 🤗

تفضل أخي @waheidi2005 ، هذه محاولتي المتواضعة 
New Microsoft Access Database.accdb

أخي @عبد اللطيف سلوم ، هل هذا ما تريده ؟
فلل السعودية.accdb
 

أخي @Bshar جزاك الله خيراً على هذه الثقة 🥰 .
 
اتمنى أن أكون قد وصلت الى حل مناسب ، انظر ماذا فعلت للوصول لطلبك :-
1. قمت بالتعديل على الاستعلام والذي هو مصدر سجلات للنموذج الفرعي ليصبح فقط لفلترة الاسم . بهذا الشكل SQL :-
SELECT doc.name, tape.ID, tape.[code-work], tape.[t-namber], tape.type, tape.lincec, tape.color FROM doc INNER JOIN tape ON doc.ID = tape.[code-work] WHERE (((doc.name) Like "*" & [Forms]![add-tab]![xxf] & "*")); 2. انشأت مربع نص وأسميته Foksh 😁 ، وجعلت قيمته :-
Me.Foksh = Foksh & "," & Me.xxc ' هو كومبوبوكس الألوان XXC حيث 3. انشأت دالة لتطبيق الفلترة :-
Private Sub ApplyFilter() Dim filterCriteria As String Dim selectedValues() As String Dim i As Integer selectedValues = Split(Me.Foksh, ",") For i = LBound(selectedValues) To UBound(selectedValues) If selectedValues(i) <> "" Then filterCriteria = filterCriteria & "[tape].[color] = '" & Trim(selectedValues(i)) & "' OR " End If Next i If filterCriteria <> "" Then filterCriteria = Left(filterCriteria, Len(filterCriteria) - 4) End If Me.tape5.Form.Filter = filterCriteria Me.tape5.Form.FilterOn = True End Sub 4. في حدث بعد التحديث للكومبوبوكس XXC سيتم نقل القيم الى مربع النص Foksh والفصل بين القيم عند تغييرها بالفاصلة ","  :-
Me.Foksh = Foksh & "," & Me.xxc ApplyFilter Me.tape5.Requery  
وفي النهاية هذا هو الناتج  tesst.accdb

جرب هذا المرفق أخي @imad2024 
Copy Files.accdb
 
تم انشاء مربعي النص ( Text1 , Text2 ) لتحديد المسارات ( المصدر والهدف )
وتم انشاء الزرين ( Btn1 , Btn2 ) بجانب كل مربع نص لتحديد مسار المجلدات .
وتم انشاء زر لتنفيذ عملية النسخ من - إلى
وتم انشاء دالة مستقلة للنسخ CopyFolder .
 
Private Sub Btn_Copy_Click() If Text1.Value <> "" And Text2.Value <> "" Then Dim sourcePath As String Dim destPath As String sourcePath = Text1.Value destPath = Text2.Value If Dir(sourcePath, vbDirectory) <> "" Then If Dir(destPath, vbDirectory) <> "" Then CopyFolder sourcePath, destPath MsgBox "تم نقل الملفات بنجاح", vbInformation Else MsgBox "المجلد الهدف غير موجود", vbExclamation End If Else MsgBox "المجلد المصدر غير موجود", vbExclamation End If Else MsgBox "يرجى تحديد مسار لكل من المجلد المصدر والمجلد الهدف", vbExclamation End If End Sub Private Sub Btn1_Click() Dim dialog As FileDialog Dim selectedFolder As Variant Set dialog = Application.FileDialog(msoFileDialogFolderPicker) If dialog.Show = -1 Then selectedFolder = dialog.SelectedItems(1) Text1.Value = selectedFolder End If End Sub Private Sub Btn2_Click() Dim dialog As FileDialog Dim selectedFolder As Variant Set dialog = Application.FileDialog(msoFileDialogFolderPicker) If dialog.Show = -1 Then selectedFolder = dialog.SelectedItems(1) Text2.Value = selectedFolder End If End Sub Private Sub CopyFolder(ByVal sourcePath As String, ByVal destPath As String) Dim fso As FileSystemObject Set fso = New FileSystemObject Dim sourceFolder As Folder Set sourceFolder = fso.GetFolder(sourcePath) Dim destFolder As Folder Set destFolder = fso.GetFolder(destPath) fso.CopyFolder sourceFolder.Path, destFolder.Path End Sub  

جرب هذا المرفق :-
asd.accdb

اخي الكريم وعليكم السلام ورحمة الله وبركاته ، وتقبل الله طاعاتكم .
اولاً راجع هذه المشاركة بالدرجة الأولى للأستاذ @jjafferr لفهم كيفية تقسيم قاعدة البيانات وجعلها قابلة للمشاركة لأكثر من مستخدم.

أخي الكريم @2saad ، كل عام وأنت بخير
 
بالنسبة لإنشاء تقارير من الاستعلامات هو يتميز بعدة نقاط منها :-
المرونة : تستطيع استخدام الاستعلامات لتحديد البيانات التي تريد عرضها في التقرير بناءً على شروط محددة .

التحكم في البيانات : أيضاً تستطيع استخدام الاستعلامات لتنفيذ العمليات الحسابية أو الوظائف المعقدة على البيانات قبل إدراجها في التقرير ، وبالطبع هذا يمكنك لمرونة أكبر في عرض البيانات.

إعادة الاستخدام : بإمكانك استخدام نفس الاستعلام في تقارير متعددة إذا كانت تحتاج إلى عرض بيانات مماثلة.
 

أما إنشاء تقارير مباشرة من الجداول فيتميز بعدة أمور منها :-
البساطة و السرعة

بما أن المشكلة في وجود مسافات في إسم الجدول المستهدف لتصدير سجلاته . فالحل بسيط بإذن الله 
 
لاحظ في السطر التالي الأساسي :-
i_strSql = "Select * From " & Me.cmb_TQ_Name سيأخذ اسم الجدول المكون من 4 مقاطع على فرضاً ( وليس بالضرورة لغة عربية أو انجليزية ) ولن يتعرف على الإسم كاملاً . لكن ! في التعديل التالي ستلاحظ الفرق بأن الكود أخذ الإسم كاملاً بكل مقاطعه عند استخدام علامات الإقتباس [ و ] :-
i_strSql = "Select * From " & "[" & Me.cmb_TQ_Name & "]"  
طبعاً الشكر موصول لأخونا @ابو الآء على هذا الطرح الجميل  وهذا أثر جميل له رغم أن عمر المشاركة من عام 2015 
 
على العموم جرب وأخبرني بالنتيجة 

مشاركة مع الأستاذ @محمد احمد لطفى 
 
Expr1: IIf([eltkeem_elam]="غ" And [stuehoa]="ذكر","ناجح بحكم القانون",IIf([eltkeem_elam]<>"غ" And [stuehoa]="ذكر","ناجح",IIf([eltkeem_elam]="غ" And [stuehoa]<>"ذكر","ناجحة بحكم القانون","ناجحة")))  
ونرجو منك ان تساعد الأخوة في طريقة طرح السؤال والمعطيات في طلبك حتى تلقى الإجابة المطلوبة بسرعة من طرف الأساتذة .
 
 
ناجح.accdb

في الجدول Tastudent3 في وضع التصميم ، من خصائص الجدول ، في الخانة Order By ستجد ان الحدول يحتوي اكثر من طريقة للفرز ، فقط احذف الموجود واترك 
[Tastudent3].[ID] أيضاً تم الفرز في الاستعلام في الحقل ID
محمد.accdb
وجهة نظري 😊 

متابعة الأستاذ @محمد احمد لطفى مشكورة 🥰 .
الفرق انه مشاركة الأستاذ محمد للإستخدام داخل النموذج الحالي ، ومشاركتي قابلة للإستخدام في أي نموذج دون تكرار في أي نموذج للأكواد .
 
واختر ما يناسبك .

هذا لأنه مكون من أكثر من استعلام ، وفي طريقة عرض التصميم كيف تستطيع عرض أكثر من استعلام بنفس الوقت ؟؟
 
لكن أعتقد أنك تستطيع نسخ أي كود SQL لأستعلام والذهاب إلى انشاء استعلام جديد وفي وضع الـ SQL الصق الاستعلام الذي تريده ومن ثم اعرضه في وضع عرض التصميم 
 
 
اختلف معك اخي @kkhalifa1960 .
 
هذا استعلام توحيد في هذه المشاركة غير مبني على وجود استعلامات أخرى موجودة في هذه المشاركة .

ومشاركة مع الأخوة والأساتذة:-
Private Sub StudentName_BeforeUpdate(Cancel As Integer) If DCount("*", "Student_Tbl", "StudentName = '" & Me.StudentName & "'") > 0 Then MsgBox "اسم الطالب موجود بالفعل في الجدول.", vbExclamation, "تكرار الاسم" Cancel = True End If End Sub  

ما شاء الله ، عمل جميل أخي إياد ، جزاك الله كل خير 🥰
 
لاحظت انك دمجت العمل بين الـ VBA والـ Macro 

وانا استعجبت تماماً مثلك أستاذي الفاضل . لذا توجهت الى ايجاد طريقة دون الإضطرار الى تحميل الصورة لتلافي مشكلتي التي واجهتني والتي لربما لنسخة الأوفيس أو الإصدار علاقة بالأمر . على العموم تم الحل بما يلي :-
في هذا الحدث Form_Current ، يتم تنفيذ الكود عندما يتم تغيير السجل الحالي في النموذج.
Private Sub Form_Current() On Error GoTo catch Dim imageURL As String imageURL = Me.texturl.Value If Len(imageURL) > 0 Then Me.Image45.pictureData = GetPictureData(imageURL) Else Me.Image45.pictureData = "" End If catch: Resume Next End Sub  
يتم استخدام Me.texturl لاسترجاع قيمة الرابط من حقل النص الذي يحتوي على عنوان الصورة .
إذا كان الرابط غير فارغ (Len(imageURL) > 0) ، يتم استخدام الرابط لجلب الصورة باستخدام الدالة GetPictureData ، ويتم تعيين البيانات المسترجعة إلى حقل الصورة Me.Image45.PictureData في النموذج . أما إذا كان الرابط فارغًا ، يتم تعيين قيمة فارغة لحقل الصورة .
 
كود الدالة GetPictureData 
Function GetPictureData(ByVal imageURL As String) As Variant Dim webClient As Object Set webClient = CreateObject("MSXML2.ServerXMLHTTP.6.0") On Error Resume Next webClient.Open "GET", imageURL, False webClient.setRequestHeader "Content-Type", "image/jpeg" webClient.send "" If webClient.Status = 200 Then GetPictureData = webClient.responseBody Else GetPictureData = "" End If On Error GoTo 0 Set webClient = Nothing End Function  
 
Pic From URL.accdb

تم حل المشكلة 😅
 
بس لو إني شغلت مخي 🤭

ومشاركة جانبية ..
استخدم هذا الكود في مديول :-
Function ConvertDateToText(dateValue As Date) As String Dim dayText As String Dim monthText As String Dim yearText As String dayText = Choose(Day(dateValue), "واحد", "اثنين", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة", "عشرة", "أحد عشر", "اثنا عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر", "عشرون", "واحد وعشرون", "اثنين وعشرون", "ثلاثة وعشرون", "أربعة وعشرون", "خمسة وعشرون", "ستة وعشرون", "سبعة وعشرون", "ثمانية وعشرون", "تسعة وعشرون", "ثلاثون", "واحد وثلاثون") monthText = Choose(Month(dateValue), "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") yearText = Choose(Left(Year(dateValue), 1), "ألف", "ألفان") & " و" & Choose(Right(Year(dateValue), 1), "واحد", "اثنين", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة") & " وعشرون" ConvertDateToText = dayText & " " & monthText & " " & yearText End Function  
وفي أي نموذج استدعي الكود في أي مربع نص كمثال :-
Private Sub Text_Date_AfterUpdate() Dim myDate As Date Dim formattedDate As String myDate = Me.Text_Date formattedDate = ConvertDateToText(myDate) Me.Text_Result = formattedDate End Sub  
أيضاً يمكنك استدعاء الدالة فقط بهذه الطريقة :-
Me.Text_Result = ConvertDateToText(Me.Text_Date) ConvertDateToText.accdb

جرب هذا التعديل اخي الكريم ،
Sub XY1(soundFileName As String) My.Computer.Audio.Play("sounddd\BookName\" & soundFileName & ".wav", AudioPlayMode.Background) End Sub Private Sub Button1_Click() XY1 "1" End Sub طبعاً لك حرية التعديل على "1" بمثلاً اسم مربع النص في حدث الزر ..... إلخ 
 
وأخبرني بالنتيجة 😊 

تفضل أخي @محمد سعيد رشاد .
إن كانت السجلات كبيرة وعددها كثير ، جرب هذا المرفق لحذف الكلمة التي تريدها دون التعديل على القيم أو التأثير عليها .
اختر الجدول
ثم اكتب الكلمة التي تريد حذفها من بين السجلات 
 
كود لجلب اسماء الجداول في قاعدة البيانات ، وإدراجها في الكومبوبوكس :-
Private Sub Form_Open(Cancel As Integer) Dim db As DAO.Database Dim tbl As DAO.TableDef Dim strTableName As String Me.Txt_Tbl.RowSource = "" Set db = CurrentDb For Each tbl In db.TableDefs If Not (tbl.Name Like "MSys*" Or tbl.Name Like "~*") Then Me.Txt_Tbl.AddItem tbl.Name End If Next tbl db.Close Set db = Nothing End Sub  
والكود الرئيسي هو البحث عن الكلمة التي تم ادخالها في مربع النص ، ومن ثم حذفها :-
Sub DeleteWordFromAllFields() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim strTable As String Dim strWordToDelete As String Dim fld As DAO.Field strTable = Txt_Tbl.Value strWordToDelete = Txt_Search.Value Set db = CurrentDb Set rs = db.OpenRecordset(strTable) For Each fld In rs.Fields strSQL = "UPDATE " & strTable & " SET " & fld.Name & " = Replace([" & fld.Name & "], '" & strWordToDelete & "', '')" db.Execute strSQL Next fld rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم حذف الكلمة بنجاح من جميع الحقول" End Sub  
 
Delete_Word.accdb

تفضل اخي @Abdelaziz Osman هذه الفكرة ، تم تعديل الأكواد على النحو التالي:-
في حدث بعد التحديث و حدث عند التركيز للحقل Retial 
If Not IsNull(Me.Retial) Then Cancel = True Me.Retial.Locked = True Else Cancel = False Me.Retial.Locked = False End If لاحظ أن الكود نفسه تم استخدامه في حدثين ، ولك حرية التعديل حسب حاجتك 😊
 
Retial -.accdb