Barna

جرب التعديل وانتظر حتى ظهور الرسالة ...... Dim MWordDocCopyOf As String Dim NWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Dir(CurrentProject.Path & "\" & Me.المعرف & "\", vbDirectory) <> "" Then Else MkDir CurrentProject.Path & "\" & Me.المعرف & "\" End If LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & Me.المعرف & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" If IsFileLocked(LWordDocCopyOf) = True Then MsgBox "يرجى غلق ملف الوورد!" Application.FollowHyperlink LWordDocCopyOf Exit Sub Else FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(NWordDocCopyOf).Save End If LWordDoc.Quit Set LWordDoc = Nothing DoCmd.GoToRecord , , acNext Next i Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbOKOnly, "تنبيه")

جرب كده ....... Private Sub OpenFile_Click() Dim File_Path As String, File_Name As String, Name_Path As String File_Path = Application.CurrentProject.Path & "\وارد\" File_Name = Dir(File_Path & Me.crn & "*.pdf") If File_Name = "" Then MsgBox "المستند غير محفوظ" Exit Sub End If While File_Name <> "" Name_Path = File_Name Application.FollowHyperlink Name_Path File_Name = Dir() Wend End Sub

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

تفضل ..... جرب .... legan.rar

الحمد لله رب العالمين

تفضل شاهد هذا الموضوع

هههه ابا جودي ..... اذا حضر الماء بطل التيمم ...

طيب في حدث عند تحميل النموذج ضع هذه الشيفرة ..... Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("Tb-Empl") If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) If (IsNull(rs.Fields(5))) Then rs.Edit rs![نهاية الخدمة] = rs![تاريخ التوظيف] + 365 rs.Update End If rs.MoveNext Wend End If rs.Close Set rs = Nothing

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

ربما هذا المطلوب .... Database1011.accdb

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

طيب جرب لجميع الايام .... لكن الكود كتبته للاسف طويل ويمكن اختزاله .... If Me.to.Value = "الأحد" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac1.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac2.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac3.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac4.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac5.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac6.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac7.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac8.BackColor = vbYellow End If ElseIf Me.to.Value = "الإثنين" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac9.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac10.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac11.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac12.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac13.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac14.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac15.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac16.BackColor = vbYellow End If ElseIf Me.to.Value = "الثلاثاء" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac17.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac18.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac19.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac20.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac21.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac22.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac23.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac24.BackColor = vbYellow End If ElseIf Me.to.Value = "الأربعاء" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac25.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac26.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac27.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac28.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac29.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac30.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac31.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac32.BackColor = vbYellow End If ElseIf Me.to.Value = "الخميس" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac33.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac34.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac35.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac36.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac37.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac38.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac39.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac40.BackColor = vbYellow End If End If ‏‏timetable 2022 (3) 3.accdb لي ملاحظات عامة سريع على برنامجك بشكل سريع :::::::::: اولا لو تم تعديل فترات الحصص مستقبلا ... سوف تضطر الى الدخول للكود وتعديله .... الحل ان يكون الكود مرتبط بالجدول الخاص بالحصص بحيث لو تم التعديل عليه يتعدل الكود مباشرة ... ثانيا في النموذج ايضا مربعات التسمية لفترات الحصص نفس المشكلة الاولى .... فالمفوض ترتبط بالجدول بحيث انك تعدل مرة واحده وليس كل مرة تدخل الى وضع تصميم النموذج للتعديل ... هذا ما يحضرني من ملاحظات الان ... واذا ظهر لي ملاحظات اخرى سوف اذكرها ...

انا لم اعدل شيئ .... انت جربت الملف سابقا ... ولكن على كل حال يبدو انك غيرت اعدادات جهازك .... تاكد من اعدادات التاريخ ....

طيب جرب يوم الاحد كدة ...... If Me.to.Value = "الأحد" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac1.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac2.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac3.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac4.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac5.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac6.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac7.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac8.BackColor = vbYellow End If End If timetable 2022 (3) (1).accdb

طيب جرب كده ..... timetable 2022 (3).accdb

طيب اولا : غير تاريخ الجهاز فقط للتجربة الى يوم الاحد ... لأني اشتغلت على يوم واحد فقط وانت اكمل بقية الايام نفس الطريقة اقد النموذج وليس الاكواد الكود جاهز فقط عدل مصدر بيانات مربعات النص في النموذج كما هو الحال في يوم الاحد ايضا عدل التنسيق الشرطي لمربعات النص كما هو في يوم الاحد .... بالمناسبة ملف الدكتور @د.كاف يار شغال ما في مشكلة بس اصبر عليه شوي timetable 2022.accdb

هل هذا التوزيع لمسميات الجدول صحيح قبل أن نكمل لاني لم افهم من جدولك ...

ايضا اضافة لما ذكر استاذي الحبيب .... = DFirst("Database", "MSysObjects", "[Type] = 6")

تم تعديل .... لاني فهمت الموضوع خطأ

تستاهل التكريم استاذ @Moosak

حياك الله ... استاذ نبيل... بالتوفيق

اهلا استاذ نبيل .... لاحظ التعديلات الموجودة في الصورة وشرحها بالترتيب ::::::: - جدول الارشيف المؤقت - جدول الرشيف النهائي - جدول بيانات الموظفين - نموذج الارشيف المرقت - نموذج الارشيف النهائي - نموذج رئيسي - نموذج اختيار نوع الترحيل - استعلام توحيد للترقيم حتى لا يتم تكرار الترقيم ملاحظة : لم يتم ادراج زر في النموذج الرئيسي لنموذج الارشيف النهائي ( اختر لها زر حسب برنامجك ) ..... Database26.accdb

طيب ... ابشر ... بس اوصل البيت ويكون خير

ابدا ... قاعدة If تقوم بالمهمة ...

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