نجوم المشاركات

السلام عليكم العنوان يصف المطلوب تماما لدي مربعي تحرير مصدر الصف فيهما عبارة عن سطر جملة استعلام .. يتغير المصدر بينهما حسب التحديد وهو عبارة عن فروع وموظفين فاريد ان يظهر الموظفون في المربع بناء على فروعهم في المربع الآخر المثال يغني عن المقال Database1.rar

اعرض الملف احصل على ألوان أكثر بهجة لنماذجك بإستخدام هذه الأداة {سلسلة الأدوات المساعدة المخصصة} 1.0.1 السلام عليكم ورحمة الله تعالى وبركاته استاذتى الكرام رواد المنتدى المحترمين اولا : بعد أذن استاذى الجليل ومعلمى القدير الاستاذ @منتصر الانسي --------------------------- قمت بتحميل مرفق للاستاذ منتصر جزاه الله عنا كل خير من هذا الموضوع الشيق : قمت بدراسة المرفق وتحليله بصراحة المرفق والفكرة أعجبت بهم كثيرا قمت بعمل القليل من التطوير ويتمثل هذا التطوير فى ....... طب ما تحملوا وشوفوا انتم بنفسكم وبعد إذن ستاذى الجليل قمت باقتباس الاسم والصورة من الموضوع الاصلى لان هذا المرفق هو إمتداد فقط للأفكار وها هى بضاعتكم نردها اليكم أحسن الله اليكم وشكر لكم وجزاكم عنى وعن كل طلاب العلم خيرا إن شاء الله استاذى الجليل : اتمنى أن تنال أفكارى المتواضعة استحسانكم ورضاكم صاحب الملف ابو جودي تمت الاضافه 04/21/26 الاقسام قسم الأكسيس  

فورم عمليات حسابية لتعليم الاطفال رابط الملف اسفل الفيديو

أخي الكريم إذا كان الحل هو المطلوب فقم بتعليم المشاركة كحل جزاك الله خير

اتفضل ان شاء كل شئ تمام Shift Key Bypass V 2.0.8.accdb

و عليكم السلام ورحمة الله وبركاته استخدم الصيغة =IFERROR(VLOOKUP(G2;بيانات!$S:$T;2;0);"") نقل رقم الهوية_بناء على رقم الطالب (1).xlsx

السلام عليكم ومع اني كنت متابع صامتا في الظل ، فحان الوقت للمتابعة صامتا ظاهرا 🙂

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

هههههههه ، يا عيني عليك ، اكتشفتها بنفسك .. جرب التعديل الأخير على أكثر من احتمال :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape, c As Range Dim r As Long, i As Long, n As Long Dim usedRows As Collection Dim dayCount As Long, perDay As Long, extra As Long Dim rr As Variant, lastCol As Long Dim hasLesson As Boolean Dim lessonCount As Long Dim circlesThisDay As Long If x <= 0 Then Exit Sub Set usedRows = New Collection lessonCount = 0 For r = startRow To endRow hasLesson = False For i = 3 To 10 If Cells(r, i).Value <> "" Then hasLesson = True lessonCount = lessonCount + 1 End If Next i If hasLesson Then usedRows.Add r Next r dayCount = usedRows.Count If dayCount = 0 Then Exit Sub n = 0 If x = lessonCount Then For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r ElseIf x > lessonCount Then Do While n < x For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r Loop Else perDay = x \ dayCount extra = x Mod dayCount If x > 10 And x < lessonCount Then extra = extra + 1 For Each rr In usedRows circlesThisDay = perDay If extra > 0 Then circlesThisDay = circlesThisDay + 1 extra = extra - 1 End If lastCol = 0 For i = 10 To 3 Step -1 If Cells(rr, i).Value <> "" Then lastCol = i Exit For End If Next i For i = lastCol To 3 Step -1 If Cells(rr, i).Value <> "" And circlesThisDay > 0 Then Set c = Cells(rr, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 circlesThisDay = circlesThisDay - 1 n = n + 1 If n = x Then Exit Sub End If Next i Next rr End If End Sub

سلمت اناملك استاذ منتصر جاري التجربة

علني اكون قد فهمت المنطق جيداً .. تفضل التعديل :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape Dim r As Long, i As Long, n As Long Dim c As Range Dim usedRows As Collection Dim dayCount As Long, perDay As Long, extra As Long Dim rr As Variant, lastCol As Long Dim hasLesson As Boolean If x <= 0 Then Exit Sub Set usedRows = New Collection For r = startRow To endRow hasLesson = False For i = 3 To 10 If Cells(r, i).Value <> "" Then hasLesson = True Exit For End If Next i If hasLesson Then usedRows.Add r Next r dayCount = usedRows.Count If dayCount = 0 Then Exit Sub perDay = x \ dayCount extra = x Mod dayCount n = 0 For Each rr In usedRows Dim circlesThisDay As Long circlesThisDay = perDay If extra > 0 Then circlesThisDay = circlesThisDay + 1 extra = extra - 1 End If lastCol = 0 For i = 10 To 3 Step -1 If Cells(rr, i).Value <> "" Then lastCol = i Exit For End If Next i For i = lastCol To 3 Step -1 If Cells(rr, i).Value <> "" And circlesThisDay > 0 Then Set c = Cells(rr, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, _ c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 circlesThisDay = circlesThisDay - 1 n = n + 1 If n >= x Then Exit Sub End If Next i Next rr End Sub

وعليكم السلام ورحمة الله وبركاته .. جري استخراج القيم من الخليتين كنص . في أي خلية تريدها استخدم المعادلة التالية :- =TEXT(C3,"yyyy/mm/dd") & " " & TEXT(B3,"yyyy/mm/dd")

وعليكم السلام ورحمة الله وبركاته قمت ياستبدال اللستبوكس بالورقة باخر في يوزرفورم فكرة العمل انقر على الخلية المراد وضع الوظيفة بها في العمود B يظهر الفورم قم بالاختيار ويختفى الفورم عند النقر في اي خلية اخرى لك وافر الاحترام والتقدير LISTBOX1.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Option Explicit Sub test() Dim ws As Worksheet: Set ws = Sheets("توزيع") Dim RowDest As Long: RowDest = 1 Dim Irow As Long, tmp As Long, ky As String Application.ScreenUpdating = False ws.Range("L1:L" & ws.Rows.Count).ClearContents For Irow = 7 To ws.Cells(ws.Rows.Count, "G").End(xlUp).Row ky = ws.Cells(Irow, "G").Value If ky <> "" Then tmp = IIf(ky = "آداب و فلسفة", 7, _ IIf(ky = "لغات أجنبية - إسبانية" Or ky = "لغات أجنبية - ألمانية", 8, 9)) For tmp = 1 To tmp ws.Cells(RowDest, 12).Value = ky & tmp RowDest = RowDest + 1 Next tmp End If Next Irow Application.ScreenUpdating = True End Sub Classeur2 v2.xlsm

السلام عليكم اخى ناصر ان كنت تقصد الفورم المسمي Form_Search يمكنك ان تستبدل هذا الجزء If Mycell Like "*" & CM_TextFind.Text & "*" Then بهذا السطر عله طلبك If Mycell Like CM_TextFind.Text & "*" Then