Barna

جميل ... اليس هذا ماتم في هذه الصورة

طيب في هذه الحالة .... ماهو الصحيح

طيب استاذنا @Ahmed_J جرب الشيفرة ان شاء الله تلبي طلبك ...... Dim db As DAO.Database Dim rs As DAO.Recordset Dim i, ii, R, Grad 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) ii = Me.iYear R = 0 Do Until rs.EOF numCopies = rs!سنوات_المكوث For i = 1 To numCopies If ii = 0 Then Me.مربع_تحرير_وسرد47 = Grad Me.مربع_تحرير_وسرد49 = Me.المرحلة_الوظيفية + R Exit Sub End If ii = ii - 1 Grad = rs!GradeNO Next i R = R + Me.iYear - rs!سنوات_المكوث rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing

طيب استاذ @Ahmed_J ممكن شرح ... كيف الموظف كان في التاسعة وصار في الثامنة ... بارك الله فيك ... من امس وانا احاول دبلجتها وما ركبت في رأسي ولا رأس الجهاز ممكن قصدك العاشرة والمرحلة الرابعة

ليس هناك داعي للأسف استاذي الفاضل .... بارك الله فيك .... الحمد لله انك وجدت الحل ..

اخي @Ahmed_J ردك هذا هو ما اوقف تعديلاتي لاني عجزت تركيبها في رأسي وايضا رأس الحاسب ... هههههه

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

مشاركة مع اخي @Foksh Sub PrintAllPDFsInFolder() Dim MyFolder As String Dim MyFile As String Dim MyApp As String ' تحديد المجلد الذي يحتوي على ملفات PDF MyFolder = "C:\your\path\here\" ' تحديد التطبيق الذي سيتم استخدامه لفتح ملفات PDF MyApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" ' الحصول على اسم أول ملف PDF في المجلد MyFile = Dir(MyFolder & "*.pdf") ' حلقة عبر كل ملف PDF في المجلد Do While MyFile <> "" ' فتح الملف بواسطة Acrobat Reader وطباعته Shell """" & MyApp & """" & " /h /p " & """" & MyFolder & MyFile & """", vbHide ' الانتظار لمدة 5 ثوانٍ للسماح للملف بالطباعة Application.Wait (Now + TimeValue("0:00:05")) ' الحصول على اسم الملف التالي MyFile = Dir Loop End Sub ملاحظة لم اجرب الكود .... يرجى ملاحظة أن هذا الكود يفتح كل ملف PDF بواسطة Adobe Acrobat Reader ويطبعه. يجب أن يكون لديك Adobe Acrobat Reader مثبتًا على جهاز الكمبيوتر الخاص بك ويجب أن تعرف المسار الذي تم تثبيته فيه. يمكنك تعديل المسار في الكود أعلاه ليتوافق مع المسار الذي تم تثبيت Acrobat Reader فيه على جهازك. إذا كنت تستخدم برنامجًا آخر لقراءة ملفات PDF، فسيتعين عليك تحديث الكود لاستخدام هذا البرنامج.

اخي @SAROOK السلام عليكم ورحمة الله وبركاته انظر التعديلات على الملف ..... - تم التعديل على طريقة احتساب التاخر على اساس سنوي - تم التعديل على طريقة اختيار السنة في نموذج الطباعة التقرير الشهري للغياب.accdb

وانت في صحة وسلامة ..... اللهم بلغنا رمضان ونحن والمسلمون في صحة وعافية وعزة ( ملاحظة انت ذكرتني بها ) زر التحديث المعمول في الموضوع السابق وهي احتساب يوم غياب .... قد تحتاج الى تعديل ( لان الاحتساب هل يتم على اساس سنوي أو تحسب في جميع السنوات يعني انا موظف تاخرت يومين العام الماضي وتاخرت يوم لهذه السنة ... هل تحسب ثلاث ايام تاخر أم يومين وعفى الله عما سلف ) عموما تم تعديل المرفق حسب طلبك ( اي تعديل التقرير بحيث يظهر حسب شرطين _ السنة _ الشهر ) .... تفضل التقرير الشهري للغياب.accdb

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

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

هل هذا طلبك .... انظر التقرير ....................

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

وهذا تعديل بسيط في الكود حتى لا يقع يوم التاخر في ضمن اطار اجازة الموظف ................ Private Sub Form_BeforeUpdate(Cancel As Integer) Dim rst As dao.Recordset Set rst = CurrentDb.OpenRecordset("SELECT hol.lateday, hol.ck, hol.Rea, hol.[no], hol.ck, hol.Rea, hol.absdate, hol.start_date, hol.end_date " & _ " FROM hol " & _ " WHERE (((hol.[no])=" & [Forms]![late-enter]![no] & ")) " & _ "ORDER BY hol.lateday;") rst.MoveFirst Do Until rst.EOF If rst!lateday = Me![نص15] Then MsgBox " تاريخ التاخر هذا مسجل سابقا لهذا الموظف ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do ElseIf rst!absdate = Me![نص15] Then MsgBox " الموظف غائب اليوم ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do ElseIf Me![نص15] >= rst!start_date And Me![نص15] <= rst!end_date Then MsgBox " التاريخ موجود ضمن فترة إجازة الموظف ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do End If rst.MoveNext Loop rst.Close End Sub

هذه الاسطر هو في اساسه استعلام ولكن مكتوب بطريقة SQL انظر الصور ..................

استبدل الكود لديك بهذا .......................... Private Sub Form_BeforeUpdate(Cancel As Integer) Dim rst As dao.Recordset Set rst = CurrentDb.OpenRecordset("SELECT hol.lateday, hol.ck, hol.Rea, hol.[no], hol.ck, hol.Rea, hol.absdate, hol.start_date, hol.end_date " & _ " FROM hol " & _ " WHERE (((hol.[no])=" & [Forms]![late-enter]![no] & ")) " & _ "ORDER BY hol.lateday;") rst.MoveFirst Do Until rst.EOF If rst!lateday = Me![نص15] Then MsgBox " تاريخ التأخر مكرر ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do ElseIf rst!absdate = Me![نص15] Then MsgBox " الموظف غائب اليوم ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do End If rst.MoveNext Loop rst.Close End Sub

بارك الله فيك ..... انظر الصورة لهذا الموظف قبل التحديث وبعد التحديث ( هل هذا هو المطلوب ) ؟؟؟؟؟؟ جرب المرفق واعلمنا بالنتيجة ..... الغياب والتاخير.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

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

أخي الكريم @عبدالقدوس48 هل تتوقع ان من يجيب هو من يضع الامثلة والمرفق ..... ام السائل هو من يزودنا بالمرفق للتطبيق عليه بعد دراسة طريقته في البرنامج ووضع الحل المناسب لمرفقه .... بارك الله فيك

وعليكم السلام ورحمة الله وبركاته ... منذ ان شاهدت الموضوع وانا افكر في هذا الاسلوب ... يعني انا لوكنت موظف وعارف اني متأخر .... لن احضر الا في الساعة الاخيرة من الدوام ...

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

تفضل حسب طلبك ..... الأعوام بين تاريخين.accdb

الأعوام بين تاريخين.accdb