kanory

جرب المرفق .....................
 
New Microsoft Access Database (9).accdb

تفضل ...................
 

tah.accdb

راجع المرفق وتأكد فقط الان من الشروط الاربعة هل تحققت ..........
 
Datab (officena).accdb

تفضل ....
Private Sub Command6_Click() If CheckA.Value = True Then DoCmd.OpenReport "Report1", acViewPreview End If If CheckE.Value = True Then DoCmd.OpenReport "Report4", acViewPreview End If If CheckC.Value = True Then DoCmd.OpenReport "Report2", acViewPreview End If If CheckD.Value = True Then DoCmd.OpenReport "Report3", acViewPreview End If End Sub  

طيب <><><><><><>
اكيد مع عمل البرنامج تظهر عبارات اخرى ..... على العموم اضفت مصفوفة يمكن من خلالها اضافة عبارات اخرى 
Private Sub ComboBox1_Change() Dim lastChar As String lastChar = Right(ComboBox1.Text, 1) myT = Array("مدام", "عبارة1", "عبارة2") For Each t In myT If t = ComboBox1.Value Then TT = t: Exit For End If Next t If ComboBox1.Value = TT Or lastChar = "ه" Or lastChar = "ة" Then ComboBox2.SetFocus: ComboBox2.Text = "female" Else ComboBox2.SetFocus: ComboBox2.Text = "male" End If End Sub  

طيب جربي المرفق هذا <><><><><>
 
LABBB (2).accdb

طيب اعمل مثلا زر امر وضع فيه هذه الشيفرة <<<<<<<<<>>>>>>>>
Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim strSQL As String Set db = CurrentDb Dim mov_st As String Dim rst As Recordset Set rst = CurrentDb.OpenRecordset("SELECT TAB3.HNO, TAB3.SUB_ID, DCount(""ID"",""TAB3"",""[HNO] ="" & [HNO] & "" and [SUB_ID] ="" & [SUB_ID] & """") AS Expr1, TAB3.CHEK, TAB3.ID, DCount(""ID"",""TAB3"",""[HNO] ="" & [HNO] & """") AS Expr2 " & _ " FROM TAB3;") rst.MoveFirst mov_st = rst!ID Do While Not rst.EOF If rst!Expr2 > rst!Expr1 And rst!Expr1 = 1 And rst!Expr2 > 2 Then rst.Edit rst!CHEK = True rst.Update ElseIf rst!Expr2 > rst!Expr1 And rst!Expr1 = 1 And rst!ID > mov_st Then rst.Edit rst!CHEK = True rst.Update Else End If mov_st = rst!ID rst.MoveNext Loop rst.Close Me.Refresh strSQL = "SELECT TAB3.ID, TAB3.MNO, TAB3.TNO, TAB3.HNO, TAB3.SUB_ID, TAB3.CHEK FROM TAB3 WHERE (((TAB3.CHEK)=True)) " 'db.QueryDefs.Delete "kanory" Set qdf = db.CreateQueryDef("kanory", strSQL) MsgBox "يتم الان فتح استعلام الاخطاء ", vbInformation + vbMsgBoxRight + vbOKOnly, "ملاحظة" DoCmd.OpenQuery "kanory", acNormal, acEdit  

حاول استخدام هذا وعدل حسب الشيفرة لديك ...
Wdoc.SaveAs2 CurrentProject.Path & "\" & Me.RintNO & "-MyDoc" & ".docx"  

مشاركة مع الاساتذة .....
ضع هذا الفانك في النموذج 
Function CountFields() Set db = CurrentDb() Set RS = db.OpenRecordset("SELECT tb_1.[لغة عربية], tb_1.رياضيات, tb_1.علوم, tb_1.[تربية إسلامية], tb_1.[دراسات اجتماعية] FROM tb_1;") RS.MoveFirst Do While Not RS.EOF Countt = 0 For Each Item In RS.Fields If RS.Fields(Item.Name).Value <> "" Then Countt = Countt + 1 Next Item RS.MoveNext Loop [نص35] = Countt End Function واستدعيه من حدث الحالي للنموذج بهذا الشكل CountFields
جرب واعلمنا هل هذا هو المطلوب <<<<<<<<<<<<<<<<<<
 

طيب اضف هذا السطر في فانك الفورمات لديك <<<<>>>>>>>
.usedRange.ReadingOrder = -5004  

اسف جدا أخي ابا محمد اقصد هذه المكتبة قد اشرت لها سابقا خطأ .. هذه المكتبة المطلوبة اخي الكريم ..... ارجو المعذرة
 

مشاركة مع اساتذتي الكرام ........ استبدلها بهذا فقط
=Int(DateDiff("d";[date_naissance];Date())/365.25)  

هل هذا المطلوب ....
 
 
My Prog.accdb

سقط سهوا ....
 

20231220.mdb

تابع هذا الموضوع ...

برنامج العقود - 4.accdb

مشاركة مع الغالي @عمر ضاحى جرب واعلمنا بالنتيجة <><><><><><><><><>
DoCmd.GoToRecord , , acFirst For i = 1 To Me.mh1 kan = "" If Me.daraja <> "" Then Me.CurrFasl = "F" kan = Me.daraja End If DoCmd.GoToRecord , , acNext Next i For ii = 1 To Me.Recordset.RecordCount If Me.daraja = kan Then Me.CurrFasl = "F" DoCmd.GoToRecord , , acNext End If Next ii MsgBox "لقد تم بنجاح", vbOKOnly  

لاننا لسنا محترفين يجب عليك تزويدنا بمثال لنفهم ما تريد ..... على كل حال هذا الكود يقوم بالمطلوب .... 
On Error Resume Next Dim db As DAO.Database Dim rs As DAO.Recordset Dim x, z As String Set rs = CurrentDb.OpenRecordset("Table") If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) x = rs!key rs.Edit rs!PicPath2 = Application.CurrentProject.Path & "\" & "Pictures" & "\" & x rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing DoCmd.Requery MsgBox "تم التعديل"  

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

times24.accdb

لم تزودنا ببيانات اضافية للتجربة .... على العموم جرب المرفق عسى يفي بالغرض المطلوب ... وحاول تعديل الكود حسب بياناتك الاساسية لديك ...
 
‏‏مثال (4) - نسخة.accdb

مشاركة مع اخي @محمد احمد لطفى
تفضل .....
Output_Path = "C:\Users\ACER\Desktop" & "\" & Format(Date, "dd-mm-yyyy") & ".xlsx" DoCmd.OutputTo acOutputQuery, "استعلام1", "ExcelWorkbook(*.xlsx)", Output_Path, True, "", , acExportQualityPrint  

اين هذا الجدول ؟؟؟؟
ارجو ارفاق نموذج به بيانات وهمية للتجريب والمحاولة ...

جرب المرفق بعد اذنك اخي محمد البرناوي <><><><><><><><><>
 
ForTest.accdb

جرب كده ..............
عند حدث الفتح ...
DoCmd.SetOrderBy "datet, fonction, name ASC"  

تفضل <><><><><><><><>
وممكن تختصر الفلم الموجود في التقرير بهذا .... انا تركتها للتوضيح فقط
للتاريخ =Format(Date();"dd/mm/yyyy") للوقت =Format(Time();"hh:nn:ss ampm") sptialtest.accdb