كل الانشطه

اولا الكود يعمل لدي بشكل جيد ......... لكن هذا غير مجدي العمل الذي ارسلته لك سابقاَ عمل أكسس .............

لم يتم تفعيل الكود لا بد من عدم قبول قيم مكررة فى حقلين معا داخل نموذج اكسيس اسم النموذج "fqagr" "codevendor" اسم الحقل الاول "no" اسم الحقل الثانى اسم الجدول الذى يحتوى البيانات :agreem ملاحظة يمكن الاستعانة بعمل استعلامات ان امكن

تفضل استاذ @Abdelaziz Osman محاولتي حسب مافهمت .اليك المرفق . Mismatch (1).rar

زودت جدول يحفظ النتائج تراكمياً (tbl_AllTemp) وباقي الاعمال التي زودتها امشي حسب الترتيب وانت ستفهم الباقي ....... لكن لي ملاحظة لما تزود ممتحن زوده عن طريق الرقم 1 علشان بيختار رقم الموظف الجديد تلقائياً . أي لستفسار أنا حاضر ز ووافني بالرد . SamerFinal_2.rar

بالغ التحية ارجو ايجاد حل مباشر للطلب الثانى فقط ولكم جزيل الشكر

بارك الله فيك وعلى الشرح البسيط

وعليكم السلام ورحمة الله تعالى وبركاته هذا يتطلب ببساطة تحديد حجم ثابت للدوائر بدلا من حسابه بناء على حجم الخلايا يمكنك تغيير هذه القيمة حسب الحجم الذي ترغب فيه tmp = 10 Option Explicit Sub DrawCircles() Const SROW As Long = 6, EROW As Long = 10, SCOL As Long = 2, ECOL As Long = 9 Dim ws As Worksheet, sColName As String, i As Long, j As Long, n As Long, tmp As Double Application.ScreenUpdating = False Call DelShap Set ws = ActiveSheet tmp = 10 For i = SROW To EROW With ws n = .Range("k" & i).Value For j = ECOL To SCOL Step -1 If .Range(.Cells(i, j).Address).Value <> Empty And n > 0 Then sColName = Split(.Cells(1, j).Address, "$")(1) With ActiveSheet.Shapes.AddShape(msoShapeOval, _ .Range(sColName & i).Left + 0.5 * (.Range(sColName & i).Width - 2 * tmp), _ .Range(sColName & i).Top + 0.5 * (.Range(sColName & i).Height - 2 * tmp), _ 2 * tmp, 2 * tmp) .Line.Weight = 2 .Line.ForeColor.RGB = RGB(10, 10, 10) .Fill.Visible = msoFalse End With n = n - 1 End If If n = 0 Then Exit For Next j End With Next i Application.ScreenUpdating = True End Sub

نعم أخي @نبا زيد يمكننا فعل دالك لاكن لدي إقتراح أعتقد أنه أفضل بدلا من تعديل الألوان مباشرة في الكود كل مرة يمكنك تحديد ألوان الخلفية ولون الخط بسهولة من داخل ورقة تمت إظافتها للملف بإسم الإعدادات كما هو موضح في الصورة التالية كل ما عليك فعله هو 1) تحديد اسم الحالة في العمود A مثل غائب - متأخر - مجاز - عطلة - حاضر - نهاية الأسبوع 2) اختيار اللون المناسب للخلفية في العمود B 3) اختيار اللون المناسب للخط في العمود C كل حالة سيتم تلوينها تلقائيا بناء على الألوان التي تحددها في ورقة الإعدادات مما يتيح لك تعديل الألوان في أي وقت بما يتناسب مع احتياجاتك دون التأثير على الكود أتمنى أن تجد هذه الفكرة مفيدة بالتوفيق Option Explicit Sub Remplissez() On Error GoTo SupApp Const FontName As String = "Arial" Const StartCol As Long = 5, TimeCol As Long = 4, NamArr As Long = 2 Const StartRow As Long = 7, LastCol As Long = 34 Dim xTime As String, Snt As String, Key As String, Icon As String Dim tmp As Object, tbl As Object, xColor As Object, xFont As Object Dim xAbsen As String, xName As String, DayName As String, Status As String Dim LastRow As Long, i As Long, col As Long, r As Long, n As Long, xDate As Date Dim f As Boolean, sWeekend As Boolean, a As Variant, b As Variant, c As Variant, j As Range Dim dest As Worksheet: Set dest = Sheets("الاستمارة") Dim CrWS As Worksheet: Set CrWS = Sheets("التواريخ") Dim WsSet As Worksheet: Set WsSet = Sheets("الإعدادات") Icon = ChrW(&H2714): xAbsen = ChrW(&H274C) Set tmp = CreateObject("Scripting.Dictionary") Set tbl = CreateObject("Scripting.Dictionary") Set xColor = CreateObject("Scripting.Dictionary") Set xFont = CreateObject("Scripting.Dictionary") For r = 2 To WsSet.Cells(WsSet.Rows.Count, "A").End(xlUp).Row Dim OnRng As String: OnRng = Trim(WsSet.Cells(r, 1).Value) If OnRng <> "" Then xColor(OnRng) = WsSet.Cells(r, 2).Interior.Color xFont(OnRng) = WsSet.Cells(r, 3).Interior.Color End If Next r SetApp False For r = 4 To CrWS.Cells(CrWS.Rows.Count, "A").End(xlUp).Row If Trim(CrWS.Cells(r, 3).Value) = "عطلة" Then tmp(CLng(CrWS.Cells(r, 1).Value)) = True Next r For r = 4 To CrWS.Cells(CrWS.Rows.Count, "E").End(xlUp).Row If CrWS.Cells(r, 5).Value <> "" And IsDate(CrWS.Cells(r, 6).Value) Then xName = Trim(CrWS.Cells(r, 5).Value) xDate = CrWS.Cells(r, 6).Value xTime = Trim(CrWS.Cells(r, 9).Value) Status = Trim(CrWS.Cells(r, 7).Value) Key = xName & "|" & CLng(xDate) & "|" & xTime tbl(Key) = Status If xTime = "صباحي/مسائي" Then tbl(xName & "|" & CLng(xDate) & "|صباحي") = Status tbl(xName & "|" & CLng(xDate) & "|مسائي") = Status End If End If Next r LastRow = dest.Cells(dest.Rows.Count, 4).End(xlUp).Row a = dest.Range(dest.Cells(StartRow, 1), dest.Cells(LastRow, LastCol)).Value b = dest.Range(dest.Cells(5, StartCol), dest.Cells(5, LastCol)).Value c = dest.Range(dest.Cells(6, StartCol), dest.Cells(6, LastCol)).Value For i = 1 To UBound(a, 1) If Trim(a(i, NamArr)) <> "" Then xName = Trim(a(i, NamArr)) For col = StartCol To LastCol n = col - StartCol + 1 If IsDate(b(1, n)) Then xDate = b(1, n): DayName = c(1, n): f = tmp.exists(CLng(xDate)) sWeekend = (DayName = "الجمعة" Or DayName = "السبت") xTime = Trim(a(i, TimeCol)) Key = xName & "|" & CLng(xDate) & "|" & xTime Status = IIf(tbl.exists(Key), tbl(Key), "") a(i, col) = IIf(f Or sWeekend Or Status = "غائب" Or _ Status = "مجاز" Or Status = "متأخر", xAbsen, Icon) End If Next col Next i dest.Range(dest.Cells(StartRow, 1), dest.Cells(LastRow, LastCol)).Value = a With dest.Range(dest.Cells(StartRow, StartCol), dest.Cells(LastRow, LastCol)) .Font.Name = FontName: .Font.Bold = True .Font.Color = vbBlack: .Interior.ColorIndex = xlNone For Each j In .Cells If j.Value = Icon Then If xColor.exists("حاضر") Then j.Interior.Color = xColor("حاضر") If xFont.exists("حاضر") Then j.Font.Color = xFont("حاضر") ElseIf j.Value = xAbsen Then Dim ColArr As Long: ColArr = j.Column - StartCol + 1 Dim RowArr As Long: RowArr = j.Row - StartRow + 1 xDate = b(1, ColArr) If Trim(a(RowArr, NamArr)) <> "" Then xName = Trim(a(RowArr, NamArr)) xTime = Trim(a(RowArr, TimeCol)) Key = xName & "|" & CLng(xDate) & "|" & xTime Status = IIf(tbl.exists(Key), tbl(Key), "") Snt = IIf(tmp.exists(CLng(xDate)), "عطلة", IIf(c(1, ColArr) = "الجمعة" Or _ c(1, ColArr) = "السبت", "نهاية الأسبوع", Status)) If xColor.exists(Snt) Then j.Interior.Color = xColor(Snt) If xFont.exists(Snt) Then j.Font.Color = xFont(Snt) End If Next j End With ExitSub: SetApp True MsgBox "تم تحديث البيانات بنجاح", vbInformation Exit Sub SupApp: Resume ExitSub End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next Application.ScreenUpdating = enable Application.EnableEvents = enable Application.DisplayAlerts = enable Application.Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End Sub استمارة-بعض النتائج المطلوبة v3.xlsb

استاذي ساعدني فقط الذي تقدر عليه ليش شرط كل الملاحظات

طيب تمام أنفذها على بقية النماذج ملحوظة: أثناء التصميم لفت نظرى شىء وهو لما بسجل بيانات التدريب بكتب تاريخ التدريب وتاريخ الانتهاء وبعد كده المدة وتاريخ مباشرة العمل #فقلت لنفسى ليه متبقاش المدة تلقائى تتحسب بناء على تاريخ البداية وتاريخ النهاية وتاريخ مباشرة العمل بردو تلقائى يكون التاريخ اللى بعد تاريخ الانتهاء مع مراعاة مندخلش يوم الجمعة والسبت فى الحسبة بمعنى لو تاريخ الانتهاء كان يوم خميس يجيب تاريخ يوم الاحد أرجو أن تكون الفكرة واضحة

هي عائدة لك ولأفكارك في التصميم ، لكن كفكرة جميلة .. قمت بتصحيح فكرة عدد السجلات الذي كان لم يعمل Personnel_affairs.zip

برأيي هذه الفكرة قد تغني عن الكثير من التقارير .. فالفكرة قد تكون كالآتي .. في مجتمعنا التعليمي في الأردن ( على سبيل المثال ) الشهادة الدراسية تحتوي درجات الفصلين ( الأول والثاني ) ففي الفصل الأول يتم تعبئة العمود الخاص بالفصل الأول ودرجاته للمواد حسب الصف . بمعنى أدق الشهادات موحدة في تصميمها باختلاف الصفوف وموادها . ويأخذ الطالب نسخة عن هذه الشهادة وفي الفصل الثاني يتم طباعة شهادة تشمل الفصلين ( كوجه مقارنة للطالب ) ويأخذ المتوسط للفصل الدراسي الثاني باعتماد درجته للترفيع . ان شاء الله ستتمكن من ذلك . قد تكون العقبات على حد علمي بالاستعلامات الحالية وبنيتها .. هذا والله اعلم

السلام عليكم ورحمة الله وبركاته شكرا جزيلا لكم جميعا على الاهتمام الآن صممت نموذج ( Frm_Regist) لتسجيل التدريبات والاجازات والعقوبات وغير ذلك للموظفين وضعت فيه حقل غير منضم لجلب اسماء الموظفين وعلى سبيل المثال عملت نموذجين الأول (Frm_Trining) يجلب بيانات الموظفين اللى محتاجها تظهر من جدول البيانات الأساسية الثانى(Frm_Trining1) نموذج لتدريبات الموظف وبياناته طبعا من جدول التدريبات نختار اسم الموظف ثم الضغط على تسجيل التدريبات تظهر البيانات وقمت بتسجيل تدريب لموظف للتجريب هل الطريقة دى صحيحة ؟ وإن كانت كذلك أنفذها على البقية ( الاجازات والعقوبات وغير ذلك ) وإن كانت غير صحيحة فما الصح ؟ Personnel_affairs.accdb

ان شاء الله علي بركة الله

الآن لدينا 14 تقرير عدا التقرير الجديد المفترض تكون 4 تقارير فقط ( كشفين للنصف الدراسي الاول والثاني ، ومثلهما تقريرين للشهادات ) بشرط تغطي كل الشروط والمتطلبات ما دمت متفق معي دعني اجرب واحاول .. لعلي اتمكن من ذلك قلت( لعلي ) لأنها فكرة لم احسب ابعادها فقد تصادفنا امور تقف في طريق تنفيذ الفكرة اذا نجحت الفكرة سنطبقها على تقارير الدرجات ( علما ان تقارير الدرجات سهلة ويسيرة ويمكن تطبيقها ان شاء الله)

شكرا جدا أ / عبد الله تسلم ايد حضرتك

الله الله الله ينور عليك أخي الفاضل ( أبو خليل ) فكرة رائعة وشكرا للأخ الفاضل ( foksh ) علي فكرة الملف الثانية

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

وعليكم السلام ورحمة الله وبركانه الكود يقوم بفرز الاسماء المكررة ويضعها في العمود C Sub تجميع() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim dict As Object Dim name As Variant, location As String Dim outputRow As Long Set ws = ActiveSheet Set dict = CreateObject("Scripting.Dictionary") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow name = ws.Cells(i, 1).Value location = ws.Cells(i, 2).Value If name <> "" Then If dict.Exists(name) Then dict(name) = dict(name) & " / " & location Else dict(name) = location End If End If Next i ws.Range("C1:D" & ws.Rows.Count).ClearContents outputRow = 1 For Each name In dict.Keys ws.Cells(outputRow, 3).Value = name ws.Cells(outputRow, 4).Value = dict(name) outputRow = outputRow + 1 Next name End Sub Book2.xlsb

ومشاركة مع أستاذي @ابوخليل ، هذه فكرتي المتواضعة .. حيث قمت بانشاء دالة في المديول = Public Function GetMada1ValByNum(Stucard As String, SafId As Long, madaNum As Long) As Variant GetMada1ValByNum = DLookup("mada1", "Tbl_degree_Detail", _ "Stu_card = '" & Stucard & "' AND Elsaf = " & SafId & " AND madaNum = " & madaNum) End Function لجلب قيمة الحقل Mada1 لكل طالب حسب معرف المادة . حيث يتم الاستدعاء في مربع النص بالشكل التالي =GetMada1ValByNum([id_student],[alsaf_Id],1) حيث 1 = رقم المادة ، وقابل للتغير حسب المواد لاحقاً وفي الغياب للذكور = =IIf([gender]=1,DCount("mada1","Tbl_degree_Detail","Stu_card='" & [id_student] & "' AND Elsaf=" & [alsaf_Id] & " AND mada1=0"),0) وللإناث = =IIf([gender]=2,DCount("mada1","Tbl_degree_Detail","Stu_card='" & [id_student] & "' AND Elsaf=" & [alsaf_Id] & " AND mada1=0"),0) لا اعلم ان كانت النتائج دقيقة ، ولكن لصاحب الشأن أخي @2saad المتابعة وإخباري بالنتيجة .. Database36.zip

الله ينور علي حضرتك ويعطيك الصحة والعافية ويزيدك من علمه

طيب جرب هذا للفصل الاول للصفوف الدنيا والثالث Database38.rar

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

شكرا أخي الفاضل بطريقة أوضح حضرتك عملت نموذج يظهر عند فتح البرنامج وبه زر التقارير عند الدخول عليه يظهر قائمة بالعام الدراسي باختار العام الأول او الثاني واختار الفئة ثم اختار الصف ثم اختار كشف أو استمارة أنا عايز نفس الخطوات وبدلا من زر كشف محتاج زر يجلب لي تقرير بدرجة التحريري فقط ( mada1 ) أو ( mada2 ) لكل الفرق بحيث التقرير يشمل علي جميع المواد انظر الصورة مثل هذه الصورة

افهم من هذا انك تريد تقريرين باختبار المادة واحد لاختبار المادة النصف الاول والتقرير الثاني لاختبار المادة النصف الثاني لجميع الصفوف صح ؟؟؟