كل الانشطه

السلام عليكم ورحمة الله وبركاته اذا تكرمتم محتاج شيت اكسل لمتابعة رصيد اجازات الموظفين مع العمل يوضح فيه كامل الاجازات للموظفين ( شكرا

الموضوع قديم يغلق ،،،

الموضوع قديم جدا يرجى فتح موضوع بعنوان جديد بطلبك يغلق ،،،

أخي الكريم حتى لا يتم إهمال الموضوع والمتابعة له ، أنصحك بفتح موضوع جديد والإشارة الى هذا الموضوع إن كان له أي دور في حل مشكلتك. ثم حاول استخدام الزر <> في محرر المشاركة لإضافة الأكواد . ليسهل عليك وعلى المتابعين تمييز وقراءة الأكواد 🤗 . وإن شاء الله ستجد حلوووول كثيرة تعجبك.

وعليكم السلام ورحمه الله وبركاته تفضل Option Explicit Sub Sucess_Fail() Dim WSData As Worksheet, WSSucess As Worksheet, WSFail As Worksheet, arr As Variant Dim i As Long, J As Long, P As Long, PP As Long, LR As Long, StateRng As Range, State1 As Long, State2 As Long Set WSData = ThisWorkbook.Worksheets("شيت") Set WSSucess = ThisWorkbook.Worksheets("ناجح") Set WSFail = ThisWorkbook.Worksheets("دور ثان") LR = Application.Max(3, WSData.Cells(Rows.Count, "B").End(xlUp).Row) arr = WSData.Range("A3:P" & LR).Value Set StateRng = WSData.Range("P2" & ":P" & LR) WSSucess.Range("A5:O" & Application.Max(5, WSSucess.Cells(Rows.Count, "B").End(xlUp).Row)).ClearContents WSFail.Range("A5:O" & Application.Max(5, WSFail.Cells(Rows.Count, "B").End(xlUp).Row)).ClearContents State1 = WorksheetFunction.CountIf(StateRng, "ناجح") State2 = WorksheetFunction.CountIf(StateRng, "دور ثان") P = 1 PP = 1 ReDim Sucess(1 To State1, 1 To UBound(arr, 2) - 1) ReDim Fail(1 To State2, 1 To UBound(arr, 2) - 1) For i = 1 To UBound(arr, 1) For J = 2 To UBound(arr, 2) - 1 If arr(i, 16) = "ناجح" Then Sucess(P, 1) = P Sucess(P, J) = arr(i, J) If J = 15 Then P = P + 1 ElseIf arr(i, 16) = "دور ثان" Then Fail(PP, 1) = PP Fail(PP, J) = arr(i, J) If J = 15 Then PP = PP + 1 End If Next J Next i If P > 0 Then WSSucess.Range("A5").Resize(P - 1, UBound(Sucess, 2)).Value = Sucess If PP > 0 Then WSFail.Range("A5").Resize(PP - 1, UBound(Fail, 2)).Value = Fail End Sub Sucess_Fail.xlsm

وعليكم السلام ورحمة الله وبركاته تفضل اخى جرب الملف book9.xlsm

السلام عليكم ورحمة الله وبركاته مرفق ملف اكسيل به عدد 2 شيت الشيت A به درجات الطلاب وأريد بالشيت B تحليل لنتائج الطلاب كالتالي وكما هو معروض بالمرفق أولا اختيار الصف المطلوب وعرض أسماء الطلاب حسب نتائجهم 1 المواد التي بها تدني في مستوى درجات بين 60 - 70 2 المواد التي لم يجتز فيها الطالب الحد الأدنى اقل من 60 3 المواد التي تم تعديل النتيجة الدرجة 60 وكما تعودنا دائما من خبراء الاكسيل بالمنتدى نتمنى الحصول على معادلات تفي بالمطلوب وجزاكم الله خيرا new.xlsx

السلام عليكم ايش التفاصيل المطلوبة ؟ انا مستعد اساعدك يعني مثلا اسم المريض تاريخ الزيارة الساعة الهاتف اسم الطبيب الكشفية ملاحظات .............. الخ

اذا ممكن ترفق لنا مرفق صغير، ثم صور من اللي تريده

ابشر استاذ @* بو يوسف* بس عطني وقت ومايصير خاطرك إلا الطيب .

السلام عليكم أعضاء وخبراء المنتدى الكرام تحية عطرة لكم جميعا الرجاء المساعدة فى عمل زر خاص لترحيل الناجح وترحيل الدور الثانى من خلال كود VBA ولكم جزيل الشكر book9.xlsm

السلام عليكم ورحمة الله وبركاته أساتذتي الكرام محمد هشام. @عبدالله بشير عبداللهجزاكم الله كل خير ويعجز لكلام عن شكركم أنا اسف جدا جدا عندي رجاء بسيط آخر .. هناك في الجدول في الشيت الأول SHEET1 عايز اعمل فلترة لان آخر عمود اسميته (مفتاح) يعني هاكتب فيه كلمه تدل على كل نشاط مثلا الإعاقة او الذكاء الاصطناعي او زوي الهمم وهكذا.. ، فلو عايز اعمل فلترة لكل ما يخص الإعاقة مثلا وطلع عدد من الندوات تخص هذا الموضوع عايز نتيجة الفلترة دي تتفصل برضه بنفس الطريقة الى ملفين مستقلين اكسل وبي دي اف - بمعني عايز النتيجة تشمل نتيجة الفلترة اللي هاعملها للجدول الرئيسD في SHEET1 بحيث بعد الفلتروة في SHEET1 عايز نتيجة لفلترة برضه تتفصل زي الفترة اللي بين التاريخين ومعلش الملف الاكسل او البي دي اف عايز احط ليهم عنوان فهل ينفع وجود خانة لاضافة العنوان لاني كل ما بزود سطر في الاعلى بيدي ERROR معلش انا آسف جدا جدا إنتو اخواتي في الله ربنا مايحرمني منكم يا رب ونفع بكم وزادكم بسطة في العلم وياريت معلش أخيرا عايز احط فيه كود عمل نسخة احتياطية في مكان وليكن في الD في مجلد اسمه Buckup كل فترة من الوقت .. أرجو التعديل بعد اذن حضراتكم على الملف المرفق والمعدل من قبل الأستاذ محمد هشام. وجزاكم الله كل خير مقدما وزادكم بسطة في العلم فلترة وحفظ PDF +EXCEL(1).xlsm

تفضل استاذ @2saad المرفق بعد التعديل حسب ما فهمت . ووافني بالرد . New Microsoft3-1.rar

استاذ @طير البحر مشكور وبارك الله فيك هدية مقبولة . وفقك الله .

اخي 😭 انا الان في نفس موقفك وفي نفس المشروع اذا عند نسخة من المشروع او فكرة او اي شي يساعد انا محتاج مسا عدتك وشكرا اخوك من اليمن

يوجد لدي ثلاثة جداول الاطباء والمرضى والمواعيد باسم (Appointment) في اكسس 2016 جدول الاطباء يحتوي البيانات الاساسيه وايضا وقت الدوام والانتهاء ب الساعات مثلا من الساعه 8 ص الي 6 مساء وجدول المواعيد يجود فيه ساعه الموعد وتاريخ الموعد وقمت بإنشاء نموذج للموظفين ونموذج للمرضى واستعلام لجميع بيانات المواعيد والمرضى باسم (therapist_appointments) وقمت بعمل نموذج للمواعيد. بطريقه عرض عناصر متعددة بشرط تاريخ الموعد وزر للحذف وزر للطباعه باسم (Appointment) وقمت بإنشاء نموذج اخر للمواعيد بأسم therapist_FRMمصدر بياناته استعلام داخلي فيه من جدول الموظفين اسم ورقم الموظف ووقت البدايه والنهايه للدوام. وتم اضافة جميع عناصر الاستعلام الي النموذج therapist_FRM ومن اداه اختيار اسم طبيب والاداه باسم (Therapist_ID) بعدما يتم اختيار طبيب يوحد كود بعد التحديث لهذا الاداة وهو. Private Sub Therapist_id_AfterUpdate() Dim rs As Object Dim strcriteria As String strcriteria = InputBox("Enter Therapist ID") strcriteria = Me.Therapist_ID If strcriteria > "" Then Set rs = Me.RecordsetClone With rs.FindFirst "[Therapist_ID] like " & strcriteria & "* " If .NoMatch Then MsgBox "incorrect date, please enter the right ID for the Therapist", vbExclamation, "Not Found" Else Me.Bookmark = .Bookmark End If End With Set rs = Nothing End If Me.Therapist_ID.Enabled = False Me.Command51.Visible = True End Sub يتم اختيار تاريخ. وعند اختيار الوقت يقوم بعمل دوارة حسب بدايه ونهايه الدوام بعد اختيار الوقت يتم اضافة اسم الطبيب والتاريخ والوقت الي النموذج الفرعي Appointment وبعدها اختيار اسم المريض بعد الاختيار يقوم ب المقارنه اذا لم يوجد سجل مشابه في جدول المواعيد وبعدها قمت بإضافة النموذج المواعيد كنموذج فرعي . الذي اسمه (Appointment)الي نموذج therapist_FRM وايضا قمت بعمل مربع نص لاختيار التاريخ باسم (app_date) ومربع سرد وتحرير لاختيار. الوقت باسم (app_time) طبعا لايوجد لهم مصدر عنصر التحكم لمربع الوقت والتاريخ كود. عند الادخال في مربع تحرير وسرد لعرض الوقت هو Private Sub app_time_Enter() On Error Resume Next Dim i As Date, n As Integer, oRS As DAO.Recordset, sSQL As String Dim dLowerbreak As Date, dUpperBreak As Date, dDuration As Date Dim dLowerPrecision As Date, dUpperPrecision As Date app_time.RowSourceType = "Value List" app_time.RowSource = "" If IsNull(start) Then Exit Sub Else i = start If Me.NewRecord = True Then DoCmd.RunCommand acCmdSaveRecord End If sSQL = "SELECT Therapist_ID, Dateofsession, Timeofsession" sSQL = sSQL & " FROM therapist_appointments" sSQL = sSQL & " WHERE Therapist_ID= " & Me.Therapist_ID & _ " AND Dateofsession= #" & Me.app_date & "#" Set oRS = CurrentDb.OpenRecordset(sSQL) dDuration = TimeValue("00:30") dLowerbreak = txtEnd - TimeValue("00:00") Break is a field dUpperBreak = txtEnd + TimeValue("00:00") If oRS.RecordCount = 0 Then Do If i <= dLowerbreak Or i >= dUpperBreak Then app_time.AddItem i End If i = i + dDuration Loop Until i >= txtEnd Else Do If i <= dLowerbreak Or i >= dUpperBreak Then dLowerPrecision = i - TimeValue("00:00:05") dUpperPrecision = i + TimeValue("00:00:05") oRS.FindFirst "[Timeofsession] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#" If oRS.NoMatch Then app_time.AddItem i End If i = i + dDuration Loop Until i >= txtEnd End If oRS.Close End Sub وكود بعد التحديث لنفس الاداء هو. Private Sub app_time_AfterUpdate() On Error Resume Next Me.Appointment.Locked = False Me.Appointment.Form!patient_ID.Locked = False Appointment.SetFocus DoCmd.GoToControl "Timeofsession" DoCmd.GoToRecord , , acNewRec Appointment.Form.Controls("Timeofsession") = Me.app_time Appointment.Form.Controls("dateofsession") = Me.app_date Appointment.Form.Controls("Patient_ID").SetFocus Appointment.Form.Controls("Patient_ID").Dropdown End Sub وقمت بعمل كود في النموذج المواعيد الفرعي (Appointment ) في اداة سرد وتحرير لاختيار اسم المريض والتي اسمها (Patient_ID) في حدث بعد التحديث يقوم بمقارنه الوقت التاريخ الجديد اذا لم يوجد سجل او سجلات مشابه للتاريخ والوقت يظهر ان الموعد محجوز الكود هو Private Sub Patient_ID_AfterUpdate() If DLookup("Dateofsession", "Appointment", "Timeofsession=" & Forms!therapist_frm.Form!Appointment!Timeofsession & "And Therapist_ID=" & Forms!therapist_frm.Form!Appointment!Therapist_ID & "") = Me.Dateofsession And DLookup("Patient_ID", "Appointment", "Timeofsession=" & Forms!therapist_frm.Form!Appointment!Timeofsession & "And Therapist_ID=" & Forms!therapist_frm.Form!Appointment!Therapist_ID & "") <> Me.patient_ID Then MsgBox "this time is taken", vbCritical, "Wrong time" DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True Else MsgBox "Appointment saved" End If End Sub المشكله يمكن تكرار اكثر من موعد بنفس التاريخ والوقت https://drive.google.com/file/d/1HM3jw5uOuNxGyzwDEHqPkttLsCTeQlMv/view?usp=drivesdk

جزاك الله خير الجزاء يا غالي

جميل شكرا.. لعبة بادل

استاذ @soik225998 تفضل المرفق والشرح بعد التعديل.اضغط على الاسم بالصب فورم (البيانات)........ اذا كان هذا طلبك لا تنسى الضغط على افضل اجابة . ملحوظة : انا مسحت بعض الصور نظراً لكبر حجمها حتي يمكن رفع البرنامج . تجريبي_3-1.rar

اخواني الأعزاء بعد السلام ورحمة الله وبركاته معلش أنا بتعبكم معاي كثيرا مرفق ملف به نموذج لعمل ترحيل للصفوف والقوائم لكن به مشكلتين : عند استدعاء الصفوف في التقرير كلهم تمام ماعدا الصف السادس ( يظهر في اول صف ولد وبعدها يأتي البنات ثم باقي الأولاد ) ونفس النظام عند استدعاء القوائم ما حل هذه المشكلة ؟ المشكلة الثانية عايز لما استدعي الصف يكتب في اعلي التقرير ( بيانات الصف كذا ) وكدذلك عند استدعاء القوائم يكتب في أعلي التقرير ( قائمة فصل كذا مثلا ( 3/1 ) ولكم جزيل الشكرNew Microsoft3.rar

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

والله يا أخي هحاول افصل حاجات من الملف وهرسله لحضرتك وشكرا جزيلا لمجهوداتكم

اخى kkhalifa1960 جزاك الله خير هذا عمل رائع وإضافة جميل وتعلمتها منها الكثير .. وأسف جداً على الإطالة ولكن المطلوب عند الضغط على الأسم تظهر الصورة الخاصة بالشخص

الدالة، تتطلب النص وترتيب الدرجة في النص 1 للأول 2 للثاني: Option Explicit Function GetDeg(ByVal inText As String, DegSeq As Byte) As Variant Dim Pos1 As Integer, Pos2 As Integer Dim Deg As Variant GetDeg = "" If DegSeq < 1 Or DegSeq > 2 Then Exit Function Do While InStr(1, inText, " ") > 0 inText = Replace(inText, " ", " ") Loop Pos2 = InStr(1, inText, " درج") If Pos2 = 0 Then Exit Function If DegSeq = 2 Then Pos2 = InStr(Pos2 + 1, inText, " درج") If Pos2 = 0 Then Exit Function End If Pos1 = InStrRev(inText, " ", Pos2 - 1) If Pos1 > 0 And Pos2 > 0 Then Deg = Mid(inText, Pos1 + 1, Pos2 - Pos1 - 1) End If If IsNumeric(Deg) Then GetDeg = Val(Deg) End Function ضفه في ملفك أو انشئ ملف جديد ووحدة نمطية جديدة والصق الشفرة/الكود

استاذ @soik225998 اذا كان هذا طلبك لا تنسى الضغط على افضل اجابة .