Barna

الصورة هذه ليس فيها ما يدل على المادة ... اين اسم المادة في الصورة ؟؟؟ وبعدين تبغا التصميم مثل الصورة ... من اين احضر لك التصميم هذا لانها صورة ... وانا لست مصمم فوتوشوب للاسف 😁😁😁😁

هل هذ الصورة المطلوبة .....

وعليكم السلام ورحمة الله وبركاته ... اعمل مربع نص وسمه مثلا Text7 ثم في حدث عند عداد الوقت للنموذج ضع هذا الكود ... I = I + 1 Me.Text7 = I & "%" If I = 100 Then Me.TimerInterval = 0 ثم اصنع زر وضع في حدثه .... Me.TimerInterval = 100 جرب واعلمنا بالنتيجة ؟؟؟؟

دائما رائع أخي الكريم @مبرمج سابق .... ماشاء الله تبارك الله ...

جرب هذا ::::::: Dim RanNo() As Long Private Sub RandomizeNumbers(ByVal iFrom As Integer, ByVal iTo As Integer) ReDim RanNo(iFrom To iTo) For i = iFrom To iTo RanNo(i) = i Next i Randomize (Timer) For i = iFrom To iTo j = CInt((iTo - iFrom) * Rnd + iFrom) tmp = RanNo(i) RanNo(i) = RanNo(j) RanNo(j) = tmp Next i End Sub Private Sub أمر0_Click() RandomizeNumbers 0, 28 For i = 1 To 28 List1.AddItem RanNo(i) Next i End Sub

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

طيب انظر الصور والمرفق هل هذا هو المطلوب ........ Info list.accdb

جرب التعديل وانتظر حتى ظهور الرسالة ...... 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")