Foksh

وعليكم السلام ورحمة الله وبركاته ...
بعد تتبع مصدر مربع النص Text2 .. وجدت أن أفضل حل هو الحدث التالي بعد تحديث عنصر الـ Ch1 ، بحيث يكون :-
Private Sub ch1_AfterUpdate() Dim subForm As Form Set subForm = Me.FMBoxCustomersSup.Form If Me.ch1 = True Then subForm.Filter = "([Sumمنtotalmainstax] - [Sumمنtotal_shop]) - [Price1] <> 0" subForm.FilterOn = True Else subForm.FilterOn = False End If End Sub  
وطبعاً في حدث عند التحميل للنموذج الرئيسي ، نقوم باستدعاء حدث بعد التحديث للعنصر Ch1 ، ليصبح كالتالي :-
Private Sub Form_Load() DoCmd.Maximize ch1_AfterUpdate End Sub  
ملفك بعد التعديل :-
اظهار واخفاء السجلات حسب قيمة الحقل.zip

وعليكم السلام ورحمة الله وبركاته ..
جرب هذين المرفقين بأسلوبين قريبين من بعضهما ..
 
 
Split Nums - 1.accdb Split Nums - 2.accdb

Minesweeper.zip   
 

أخي الفاضل ، لم لا تقوم بطرح جميع المطلوب كاملاً بدلاً من النقاط المبعثرة 😅
على العموم ، هذا التعديل لما طلبت ، تفضل ، استبدل الكود للزر بالتالي :-
Private Sub btnGenerate_Click() Dim db As DAO.Database Dim tDef As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Dim startDate As Date, endDate As Date, d As Date Dim yearInput As Integer Dim monthName As String Dim monthCode As Integer Dim shiftValue As Double Dim startDateTime As Date Dim endDateTime As Date Dim monthEndDate As Date Dim monthEndWorkDate As Date If IsNull(TxtYear) Then MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, "" Me.TxtYear.SetFocus Exit Sub End If yearInput = Me.TxtYear startDate = DateSerial(yearInput - 1, 12, 21) endDate = DateSerial(yearInput, 12, 20) On Error Resume Next DoCmd.DeleteObject acTable, "Salary" On Error GoTo 0 Set db = CurrentDb db.Execute "CREATE TABLE Salary (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "WorkDate DATE, " & _ "DayName TEXT(20), " & _ "MonthName TEXT(20), " & _ "monthCode LONG, " & _ "shift CURRENCY, " & _ "startDay DATE, " & _ "endDay DATE)" Set tDef = db.TableDefs("Salary") Set fld = tDef.Fields("shift") On Error Resume Next fld.Properties("Format") = "#,##0.00" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "#,##0.00") End If fld.Properties("DecimalPlaces") = 2 If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2) End If Set fld = tDef.Fields("startDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If Set fld = tDef.Fields("endDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If On Error GoTo 0 Set fld = Nothing Set tDef = Nothing Set rs = db.OpenRecordset("Salary", dbOpenDynaset) monthCode = 0 monthEndWorkDate = DateSerial(yearInput - 1, 12, 20) d = startDate Do While d <= endDate If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then monthName = CustomMonth(d) monthCode = 0 monthEndDate = DateSerial(Year(d), Month(d), 20) If Weekday(monthEndDate, vbMonday) = 5 Or Weekday(monthEndDate, vbMonday) = 7 Then monthEndWorkDate = monthEndDate Do monthEndWorkDate = DateAdd("d", -1, monthEndWorkDate) Loop Until Weekday(monthEndWorkDate, vbMonday) <> 5 And Weekday(monthEndWorkDate, vbMonday) <> 7 Else monthEndWorkDate = monthEndDate End If If d = monthEndWorkDate Then If Month(d) = 12 And Year(d) = yearInput - 1 Then monthCode = 1 ElseIf Month(d) = 1 And Year(d) = yearInput Then monthCode = 1 ElseIf Month(d) = 2 Then monthCode = 2 ElseIf Month(d) = 3 Then monthCode = 3 ElseIf Month(d) = 4 Then monthCode = 4 ElseIf Month(d) = 5 Then monthCode = 5 ElseIf Month(d) = 6 Then monthCode = 6 ElseIf Month(d) = 7 Then monthCode = 7 ElseIf Month(d) = 8 Then monthCode = 8 ElseIf Month(d) = 9 Then monthCode = 9 ElseIf Month(d) = 10 Then monthCode = 10 ElseIf Month(d) = 11 Then monthCode = 11 ElseIf Month(d) = 12 Then monthCode = 12 End If End If If Weekday(d, vbMonday) = 6 Or Weekday(d, vbMonday) = 3 Then shiftValue = 1 startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0) Else shiftValue = 1.2 startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0) End If rs.AddNew rs!WorkDate = d rs!DayName = Format(d, "dddd") rs!monthName = monthName If monthCode > 0 Then rs!monthCode = monthCode Else rs!monthCode = Null End If rs!shift = shiftValue rs!startDay = startDateTime rs!endDay = endDateTime rs.Update End If d = d + 1 Loop rs.Close Set rs = Nothing db.TableDefs.Refresh Set db = Nothing MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, "" DoCmd.SelectObject acTable, "Salary", True End Sub  
ملفك بعد التعديل :-
CalGen.zip
 

أخي @jo_2010
بما أن موضوع الحدث عند رسم النموذج يسبب مشكلة لديك ، دعنا نتوجه إلى الحل التالي . وهو إضافة بسيطة الى الاستعلام مصدر النموذج الفرعي ليصبح كالتالي :-
SELECT Switch([External_lab] Is Null,Null,[External_lab]="",Null,[External_lab]="المختبر","Almokh",[External_lab]="البرج","1_AL_Borg",True,Null) AS DisplayImage, * FROM [Qry_Analysis collection]; بدلاً من القديم :-
SELECT [Qry_Analysis collection].* FROM [Qry_Analysis collection]; وطبعاً سنحدد مصدر عنصر الصورة التي تريدها ليصبح الحقل الجديد = DisplayImage
وبالتالي النتيجة بدون ترميش وتعتمد على مصدر النموذج الفرعي نفسه . والنتيجة في المرفق .
 

تم تغيير اسم عنصر الصورة من Image ( وهو اسم محجوز لآكسيس وهو غير صحيح ) الى الاسم ImageFoksh .
ومن الجدير بالذكر والتوضيح أنني اعتمدت على اسم الصورة المضمنة في قاعدة البيانات نفسها .
 

 
JO_Lab3.zip

هذه تجربتي المباشرة على الإصدار الحديث Version 2.3000.1031261430.258708 . أحدث من إصدارك حتى ، مع العلم أن إصدارك تمت التجربة عليه سابقاً ( التطبيق موجود ضمن المشاركات ) .. انظر هذا التصوير :-
 

 

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

وعليكم السلام ورحمة الله وبركاته ..
جرب في زر فتح التقرير الحدث التالي :-
DoCmd.OpenReport "تقرير تصفية", acViewPreview, , _ "[اسم_المستفيد] Like '*" & Forms!Index!s & "*' " & _ "OR [رقم/اسم المبنى] Like '*" & Forms!Index!s & "*' " & _ "OR [الادارة] Like '*" & Forms!Index!s & "*'"  
100.zip

وعليكم السلام ورحمة الله وبركاته..
في مربع نص الاسم اختر تنسيق شرطي ، واضف قاعدة جديدة ، واختر Expression Is ، ثم في قيمة الشرط اكتب مثلاً:-
[Foksh] = "لا يوجد" انا افترضت هنا ان اسم مربع النص الذي تشترط قيمته = Foksh  😅 . ثم حدد اللون والتنسيق الذي تريده .

بسيطة أخر الكريم ..
في حدث بعد التحديث لمربع النص Payment الموجود في النموذج الفرعي Credit_Paper_Payments ، اجعل الحدث = 
Forms!credit_paper.CheckPaymentState  
ولضمان ابقاء القيمة ذاتها للكومبوبوكس عند عدم تحقق الشرط ، استبدل كلمة Null بالقيمة التالية
Me.Credit_Paper_Sub.Form!State.Value

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


 
 

 
UnMatched.zip

تفضل أخي الكريم / ملفك بعد التعديل وتوسيع النطاق في العمل .
وأرجو منك الإهتمام بمواضيعك وأغلاق ما يستحق الإغلاق إشعاراً للقارئ بأن الموضوع قد تم حله والإجابة عليه . فتفاعلك يعكس فكرك  .
UnMatched123.zip

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

تفضل التعديل التالي .. جربه وأخبرني بالنتيجة .
 
 
123452025.zip

استبدل الجملة السابقة ، بالجملة التالية :-
Me.da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & _ PartOfName(name1, 1) & " " & PartOfName(name1, 2) & _ " تحت رقم : " & rs!N_Act_Marj  
بشرط أن تكون قد قمت بنقل المديول في الملف الأول الذي تم حل مشكلتك من خلال الاستعلام .

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

وعليكم السلام ورحمة الله وبركاته ..
لدي دالة تجلب جميع أرقام الهارد ديسك ( القرص الصلب ) حتى لو كان لديك أكثر من هارد موصول على نفس الكمبيوتر ..
Public Function GetAllHardDiskSerials() As String On Error GoTo ErrorHandler Dim objWMIService As Object Dim colDisks As Object Dim objDisk As Object Dim result As String Dim i As Integer Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colDisks = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive") i = 1 For Each objDisk In colDisks If Not IsNull(objDisk.SerialNumber) Then Dim serial As String serial = Trim(objDisk.SerialNumber) If serial <> "" Then result = result & "Disk " & i & ": " & serial & vbCrLf i = i + 1 End If End If Next If result = "" Then GetAllHardDiskSerials = "No serial numbers found" Else GetAllHardDiskSerials = result End If CleanUp: Set objDisk = Nothing Set colDisks = Nothing Set objWMIService = Nothing Exit Function ErrorHandler: GetAllHardDiskSerials = "Error" Resume CleanUp End Function  
أو هذه الدالة البسيطة أيضاً التي تجلب رقم الهارد الذي تم تثبيت نظام التشغيل ويندوز عليه :-
Public Function GetHardDiskSerial2() As String On Error GoTo ErrorHandler Dim objWMIService As Object Dim colDisks As Object Dim objDisk As Object Dim strSerial As String Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colDisks = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive") For Each objDisk In colDisks If Not IsNull(objDisk.SerialNumber) Then strSerial = Trim(objDisk.SerialNumber) If strSerial <> "" Then GetHardDiskSerial2 = strSerial Exit For End If End If Next If GetHardDiskSerial2 = "" Then GetHardDiskSerial2 = "Not Found" End If CleanUp: Set objDisk = Nothing Set colDisks = Nothing Set objWMIService = Nothing Exit Function ErrorHandler: Resume CleanUp End Function  
والإستدعاء فقط في أي مربع نص = اسم الدالة فقط ، كما في الملف المرفق للتوضيح .
HD Serial.zip
 

وعليكم السلام ورحمة الله وبركاته ..
بدايةً لا تقترف خطأ كبيراً بتسمية المكونات بأسماء محجوزة لآكسيس مثل ، Form أو Group . ثم ان الفكرة بسيطة جداً .. انظر الفكرة التالية في المرفق :-
 
FAST_CA.zip

xx هي فعلاً فرق الرقم بين 14 و 16 حسب إصدارات الأوفيس لديك . وبما أنك لديك أوفيس 2010 ، فالقيمة XX ستكون 14 كما ذكرت .
على العموم ، قم بضبط و تعديل ملف الأكسل بحيث تنقل الجدول الى الخلية A ، كما في الصورة ، ثم استخدم الأداة وستجد أنها جلبت القيم لك من جدول اكسل الى جدول اكسيس .
 

 

وعليكم السلام ورحمة الله وبركاته ..
بعد الإطلاع مرتين على الملف المرفق وطريقة عملك عليه ، جرب الحدثين التاليين في الأزرار ..
Private Sub a1_Click() Dim curID As Long Dim nxt As Variant If Nz(Me.ek, "") = "" Then curID = Me.no_rece + 1 Else curID = CLng(Me.ek) End If nxt = DMin("no_rece", "enar_dman", "no_rece > " & curID) If Not IsNull(nxt) Then Me.ek = nxt Me.Requery Else MsgBox "لا يوجد سجل تالي", vbInformation + vbMsgBoxRight, "" End If End Sub Private Sub a2_Click() Dim curID As Long Dim prv As Variant If Nz(Me.ek, "") = "" Then curID = Me.no_rece - 1 Else curID = CLng(Me.ek) End If prv = DMax("no_rece", "enar_dman", "no_rece < " & curID) If Not IsNull(prv) Then Me.ek = prv Me.Requery Else MsgBox "لا يوجد سجل سابق", vbInformation + vbMsgBoxRight, "" End If End Sub  
طبعاً قد تحتاج لزر "سجل جديد" إذا كان النموذج الحالي إدخال البيانات .
 
وهذه الفكرة بدلاً من التكرار للحدثين في الزرين ،يمكن دمجهم في دالة واحدة والإستدعاء فقط من خلال الزرين يميز السابق والتالي :-
Private Sub a1_Click() GoToRecord True End Sub Private Sub a2_Click() GoToRecord False End Sub Private Sub GoToRecord(isNext As Boolean) Dim curID As Long Dim newID As Variant Dim fld As String: fld = "no_rece" If Nz(Me.ek, "") = "" Then If isNext Then curID = Me(fld) + 1 Else curID = Me(fld) - 1 End If Else curID = CLng(Me.ek) End If If isNext Then newID = DMin(fld, "enar_dman", fld & " > " & curID) Else newID = DMax(fld, "enar_dman", fld & " < " & curID) End If If Not IsNull(newID) Then Me.ek = newID Me.Requery Else If isNext Then MsgBox "لا يوجد سجل تالي", vbInformation + vbMsgBoxRight, "" Else MsgBox "لا يوجد سجل سابق", vbInformation + vbMsgBoxRight, "" End If End If End Sub  
test.zip

وعليكم السلام ورحمة الله وبركاته ..
جرب في حدث بعد التحديث لمربع النص الغير منضم الفكرة التالية ..
Private Sub AMOUNT_AfterUpdate() Dim vAmount As Double vAmount = Nz(Me.AMOUNT, 0) DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE Table1 SET JOR = Nz(US,0) * " & vAmount DoCmd.SetWarnings True DoCmd.Requery End Sub  
 

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

وعليكم السلام ورحمة الله وبركاته ..
جرب هذا التعديل الذي استعملت فيه الجملة :-
Private Sub أمر55_Click() DoCmd.OpenForm "36", , , "[الرقم]=" & Me.الرقم End Sub بدلاً من الماكرو الذي كنت تستعمله . وأيضاً قمت بحذف الشرط من استعلام النموذج "36" .
ملفك بعد التعديل :-
 
برنامج م.zip

مشاركةً مع أساتذتي ، رغم أن صاحب الموضوع لا يأبه للملاحظات التي نطرحها وأرجو أن يكتشف أنها لصالحه لاحقاً ..
جرب هذا الإستعلام أخي الكريم واستبدله باستعلامك السابق :-
SELECT (SELECT Count(*) FROM [ادوات التقييم] AS T WHERE (((T.[اسم الشركة]) Like [ادخل الفيندور الاول] Or (T.[اسم الشركة])=[الثانى]) OR ((T.[اسم الشركة])=[الثالث] And (T.[اسم الشركة]) Is Not Null)) AND T.[اسم الشركة] <= Q.[اسم الشركة] ) AS رقم_تسلسلي, Q.[اسم الشركة], Q.guarantee_value, Q.response_po, Q.cod_supply, Q.cod_cut, Q.Safety, Q.administrative, Q.Warning, Q.Quality FROM [ادوات التقييم] AS Q WHERE (((Q.[اسم الشركة]) Like [ادخل الفيندور الاول] Or (Q.[اسم الشركة])=[الثانى]) OR ((Q.[اسم الشركة])=[الثالث] And (Q.[اسم الشركة]) Is Not Null)) ORDER BY Q.[اسم الشركة];  
صورة توضيحية للنتيجة :-

 
ملفك بعد التعديل :-
 
q serial.zip

في الكومبوبوكس "Wil_Miled" قمت كتجربة بتغيير الحدث بعد التحديث من :-
Me.Com_Miled.Requery ليصبح في النموذج الفرعي F2_Sub كالتالي ( كتجربة ) :-
Private Sub Wil_Miled_AfterUpdate() If Not IsNull(Me.Wil_Miled) Then Me.Com_Miled.RowSource = _ "SELECT TblWsub.ID, TblWsub.N_C, TblWsub.Code_W " & _ "FROM TblWsub " & _ "WHERE TblWsub.Code_W = " & Me.Wil_Miled & " " & _ "ORDER BY TblWsub.N_C;" End If End Sub وكانت النتيجة كالتالي :-

 
إلا أنني غير راضٍ عن الفكرة 😢 . رغم أن أحد التقويض في الحلول هو أن النماذج الفرعية = نماذج مستمرة !!!!