Barna

Dim db As DAO.Database Dim rs As DAO.Recordset Dim fld As DAO.Field Dim searchNumber As Long Dim found As Boolean searchNumber = Me.C Set db = CurrentDb() Set rs = db.OpenRecordset("SELECT Salary.GradeNO, Salary.[1], Salary.[2], Salary.[3], Salary.[4], Salary.[5] FROM Salary ORDER BY Salary.GradeNO DESC;", dbOpenDynaset) i = 0 found = False Do Until rs.EOF For Each fld In rs.Fields If Not IsNull(fld.Value) And fld.Value = searchNumber Then found = True ElseIf found And Not IsNull(fld.Value) And i < Me.D And fld.Name <> "GradeNO" Then i = i + 1 Me.G = fld.Value Me.E = rs!GradeNO Me.F = fld.Name End If Next fld rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing  

طيب جرب على حالات اخرى ....
Dim db As DAO.Database Dim rs As DAO.Recordset Dim i, TT As Integer Dim numCopies As Integer Set db = CurrentDb Set rs = db.OpenRecordset("SELECT tp2.GradeNO, tp2.سنوات_المكوث FROM tp2 WHERE (((tp2.GradeNO)<=" & Me.الدرجة_الوظيفية & ")) ORDER BY tp2.GradeNO DESC;", dbOpenDynaset) TT = iYear Do Until rs.EOF TT = TT - rs!سنوات_المكوث numCopies = rs!سنوات_المكوث If TT < rs!سنوات_المكوث Then Me.مربع_تحرير_وسرد47 = rs!GradeNO - 1 Me.مربع_تحرير_وسرد49 = Me.المرحلة_الوظيفية + TT rs.MoveNext GoTo RR 'Exit Sub End If For i = 1 To numCopies Next i rs.MoveNext Loop RR: If Me.مربع_تحرير_وسرد49 > rs!سنوات_المكوث Then Me.مربع_تحرير_وسرد47 = rs!GradeNO - 1 Me.مربع_تحرير_وسرد49 = 1 Exit Sub End If rs.Close Set rs = Nothing Set db = Nothing  

تفضل استاذ @Ahmed_J >>> ربما يلبي طلبك .....
 

301.Dates_Calculations2.mdb

تفضل جرب ................
 
التقرير الشهري للغياب.accdb

بارك الله فيك .....
انظر الصورة لهذا الموظف قبل التحديث وبعد التحديث ( هل هذا هو المطلوب ) ؟؟؟؟؟؟
جرب المرفق واعلمنا بالنتيجة .....


الغياب والتاخير.accdb

للاسف ليس لدي سكنر ... جرب واعلمنا ..........
Public Function SelectScanner() Dim ComDialog As New WIA.CommonDialog Dim wiaScanner As WIA.Device ' عرض نافذة لاختيار الجهاز Set wiaScanner = ComDialog.ShowSelectDevice(WiaDeviceType.ScannerDeviceType, False, True) ' إذا تم اختيار جهاز، فإن DeviceID سيحتوي على معرف الجهاز المحدد If Not wiaScanner Is Nothing Then MsgBox "تم اختيار الجهاز: " & wiaScanner.DeviceID Else MsgBox "لم يتم اختيار أي جهاز." End If End Function يتطلب إضافة مرجع إلى “Microsoft Windows Image Acquisition Library v2.0

Sub InsertYears() Dim rsSource As DAO.Recordset Dim rsTarget As DAO.Recordset Dim StartDate As Date Dim EndDate As Date Dim iYear As Integer DoCmd.SetWarnings False DoCmd.RunSQL "DELETE TEMP_DATE.* FROM TEMP_DATE;" DoCmd.SetWarnings True Set rsSource = CurrentDb.OpenRecordset("date1") Set rsTarget = CurrentDb.OpenRecordset("TEMP_DATE") Do Until rsSource.EOF StartDate = rsSource!t2 EndDate = rsSource!t3 For iYear = Year(StartDate) To Year(EndDate) rsTarget.AddNew rsTarget!t2 = CStr(iYear) rsTarget!t1 = rsSource!t1 rsTarget.Update Next iYear rsSource.MoveNext Loop rsSource.Close rsTarget.Close Set rsSource = Nothing Set rsTarget = Nothing End Sub  

هل هذا طلبك حسب فهمي للموضوع ....
 

2023.mdb

مشاركة مع استاذي الغالي @Eng.Qassim
تفضل ......
 
المهن التربوية.accdb

وعليكم السلام اخي الفاضل
لم افهم جيدا لسؤالك ولكن هل تقصد هذا الخيار ؟؟؟؟ ملف .... ثم تابع الصور ...
 
 

امين واياك ....... طيب تفضل شوف كده
استخدمنا هذه الاكواد ...
Public Function PctMeter(varAmt As Variant, varTotal As Variant) Dim sngPct As Single sngPct = varAmt / varTotal If sngPct <= 1 Then Me!baselbl.Caption = Int(sngPct * 100) Me!lblmeter.Width = CLng(Me!baselbl.Width * sngPct) Else Me!baselbl.Caption = " القيمة أكبر من 100%" Me!lblmeter.Width = CLng(Me!baselbl.Width * 1) End If Select Case sngPct Case Is < 0.15 Me!lblmeter.BackColor = 255 Me.red_p.Visible = True Me.gre_p.Visible = False Me.yel_p.Visible = False Case Is < 0.5 Me!lblmeter.BackColor = 65535 Me.red_p.Visible = False Me.gre_p.Visible = False Me.yel_p.Visible = True Case Else Me!lblmeter.BackColor = 65280 Me.red_p.Visible = False Me.gre_p.Visible = True Me.yel_p.Visible = False End Select End Function Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) i = 1 For i = i To 5 If (Me("Text" & 19 + i) / Me.Text25) * 100 < 20 Then Me(i & "_red").Visible = True Me(i & "_ger").Visible = False Me(i & "_yel").Visible = False ElseIf (Me("Text" & 19 + i) / Me.Text25) * 100 > 20 Then Me(i & "_red").Visible = False Me(i & "_ger").Visible = True Me(i & "_yel").Visible = False End If Next i Call PctMeter(Me.bar, 100) End Sub  
 
New Database - .accdb

طيب جرب هذا <|<><><><><><|>
Dim rst As DAO.Recordset Set dbs = CurrentDb date_custom = Date If Len(Me.number_custom & "") <> 0 Then Exit Sub Me.number_custom = Nz(DMax("[number_custom]", "tbl_custom", "year([date_custom])=" & Year(date_custom)), 0) + 1 Set rst = dbs.OpenRecordset("FrmRretsQ") d = Me.number_custom DoCmd.RunCommand acCmdSaveRecord Do Until rst.EOF rst.Edit rst!number_custom = d rst!date_custom = Date rst!emp_company = DYear rst.Update d = d + 1 rst.MoveNext Loop Me.Requery  

اعتقد عندك مشكلة في العلاقات .... حاول ترتجعها .... على العموم هل هذا ما تريد .....
 
solaf2.accdb

مشاركة مع الاستاذ @دروب مبرمج
في حدث الحالي للنموذج الفرعي الاول ضع هذا الحدث ......
Dim rs As DAO.Recordset On Error Resume Next Set rs = Me.RecordsetClone rs.FindFirst "[ItemNumber] = " & Me![ItemNumber] Me.Parent.FrmSubInvoice.Form.Bookmark = rs.Bookmark  

اخي محمد جرب الكود التالي في حدث تحت الزر ....
Dim a As Integer a = Forms![test1]![NumberEnd] Me("LastNumberx" & a) = Forms![test1]![NumberEnd]  

لعل هذا ما تريد .... ضع هذا الحدث تحث زر GO واخبرنا ..... لأني لم افهم طريقتك في العمل ....
Dim rs As Object Set rs = Forms![test1]![SUBX].Form.RecordsetClone rs.MoveLast Forms![test1]![SUBX].Form.Bookmark = rs.Bookmark Forms![test1]![LastNumberx] = Forms![test1]![SUBX].[Form]![NumberX] rs.Close DoCmd.Close  

في النموذج وفي حدث بعد التحديث لمربع النص الخاص بالرقم ضع هذا الكود
If [Forms]![نمودج1]![الرقم] <= [Forms]![نمودج1]![نص12] Then Me.الرقم = "" MsgBox "الرقم مكرر" End If  

اخي الكريم ابحث في المنتدى تجد العديد من هذه الافكار مثل هذه
 

طبع ما في الصورة ...............
 
 
 
 
 

جرب هذا .................
Dim ExcelObj As Excel.Application Set ExcelObj = CreateObject("Excel.Application") ExcelObj.Workbooks.Open "C:\file1.xlsx" ExcelObj.Sheets.PrintOut ExcelObj.Quit Set ExcelObj = Nothing  

تفضل <><><><><><<>
 
Students (3).accdb

استخدم هذا ..................
Dim i As Integer Dim db As DAO.Database Dim rst As DAO.Recordset Set db = CurrentDb Set rst = db.OpenRecordset("t1") While rst.RecordCount >= 10 rst.MoveFirst For i = 1 To 6 rst.Delete rst.MoveNext Next Wend rst.Close MsgBox "تم حذف كل السجلات اللازمة", vbOKOnly, "تنبيه"  

نعم ولكن راجع الملف الاخير معدل ... انا اقصد الملف الاخير تم تعدي استعلامك القديم بما يتناسب سؤالك الاخير

حذف كل المرتجعات والنتيجة ممتازة .............. انظر .....