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

وعليكم السلام ورحمة الله وبركاته الكود Sub ExtractAbsentees() Dim ws As Worksheet Dim lastRow As Long, lastCol As Long Dim i As Long, j As Long Dim outputRow As Long Set ws = ThisWorkbook.Sheets("SHEET1") lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row lastCol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column outputRow = 5 For i = 5 To lastRow For j = 4 To lastCol If ws.Cells(i, j).Value = "A" Then ws.Cells(outputRow, 15).Value = ws.Cells(i, 2).Value ws.Cells(outputRow, 16).Value = ws.Cells(4, j).Value outputRow = outputRow + 1 End If Next j Next i End Sub الملف الغياب.xlsb

تفضلي : التحكم بالمسافة بين السطور في التقرير.accdb

وعليكم السلام ورحمة الله تعالى وبركاته اظافة للكود المقترح من طرف الأستاد @عبدالله بشير عبدالله جزاه الله خيرا الحل بالمعادلات الخلية (O5) لجلب الأسماء بناء على وجود غياب (A) =IFERROR(INDEX($B$5:$B$8, SMALL(IF($D$5:$H$8="A", ROW($B$5:$B$8)-ROW($B$5)+1), ROW(A1))), "") الخلية (P5) لجلب تواريخ الغياب =IFERROR(INDEX($D$4:$H$4, SMALL(IF(INDEX($D$6:$H$8, MATCH(O5, $B$6:$B$8, 0), 0)="A", COLUMN($D$4:$H$4)-COLUMN($D$4)+1), COUNTIF($O$5:O5, O5))), "") مثال .xlsx

السلام عليكم كيف الحال فكره سريعة تعرض تنبيهات للسدادات المتأخرة او الالتزامات التي اوشكت على الدفع New Microsoft Excel Worksheet.xlsm

ادخل الرمز المطلوب ثم اضغط على مفتاح انتر .... 111 (KAN).accdb

ما شاء الله تبارك الله مهندسنا مستر @Foksh 😄👏 نقلة نوعية ماشاء الله .. إشي فنتاستك 🤩👌 هذي فعلا بدها منسف يا زلمة 😋🍲 الجرافكس مع التصميم والبرمجة عامل مزيج إبداعي متميز .. تستاهل خمس نجوم ⭐⭐⭐⭐⭐.. الله يوفقك ويبارك فيك 😊🤲

السلام عليكم حقيقة كود الفاضل محمد هشام حاولت فهمه لم اتمكن من استيعابه بالكامل لانى حاولت التعدبل فيه بسبب الصورة المتحركة عند اختياره شهر 12 ظهر بالصورة بداية الشهر الاحد يوافق يوم 8 وحسب التقوبم الشهر يبدأ يوم 1 طبعا لم اجرب الملف كما قلت حسب الصورة المتحركة تأمل من استاذنا الفاضل تعدبل الكود للاستفاذة ربما التعديل التالى لاختيار التاريخ يناسبك بمكن تعديل السنوات من الكود أيام الشهر من يوم محدد - vba (1).xlsm

الخلل لديك عجيب وهو في لون خلفية الحقول الأساسي ، بمعنى ان الخلل فني وليس برمجي انظر baseT2.rar

السلام عليكم ورحمة الله وبركاته أخى محمد وعبدالله تمت الإفادة بفضل الله أولا ثم بفضلكم وافر التحية والتقدير

هدا بسبب عدم توافق نسخة الاوفيس لديك مع المعادلات المستخدمة على العموم لإثراء الموضوع أكثر اليك دالة تنفد المطلوب بادن الله عند التغيير في الخلية C2 Function xdates(StartDate As Variant) As Variant Dim Dates() As Variant Dim Days() As String Dim Result() As Variant Dim tmp As Date, r As Date Dim n As Long, i As Long, maxday As Long If IsEmpty(StartDate) Or Not IsDate(StartDate) Then xdates = Array("") Exit Function End If maxday = 30 ' الحد الأقصى لعدد الأيام r = DateSerial(Year(StartDate), Month(StartDate) + 1, 0) ' العثور على أول يوم أحد tmp = StartDate + (7 - Weekday(StartDate, vbSunday)) Mod 7 If Weekday(StartDate, vbSunday) = 1 Then tmp = StartDate End If ReDim Dates(1 To maxday) ReDim Days(1 To maxday) For tmp = tmp To r ' تجاهل يومي الجمعة (6) والسبت (7) If Weekday(tmp, vbSunday) <= 5 Then ' أيام الأحد إلى الخميس فقط n = n + 1 Days(n) = Choose(Weekday(tmp, _ vbSunday), "الأحد", "الاثنين", "الثلاثاء", "الأربعاء", "الخميس") Dates(n) = tmp If n >= maxday Then Exit For End If Next tmp ReDim Result(1 To n, 1 To 2) For i = 1 To n Result(i, 1) = Days(i) Result(i, 2) = Dates(i) Next i xdates = Result End Function في الخلية A6 =xdates(C2) في حالة الرغبة بإستخراج النتائج قيم يمكنك وضع الكود التالي في حدث ورقة Sheet1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim f As Worksheet: Set f = ThisWorkbook.Sheets("Sheet1") Dim rCrit As Variant, startRow As Long, startCol As Long On Error GoTo CleanExit startRow = 5 'رقم الصف startCol = 1 '(A)' أول عمود لوضع النتائج If Not Intersect(Target, Me.Range("C2")) Is Nothing Then rCrit = xdates(Me.Range("C2").Value) With f.Range("k6:l" & f.Rows.Count) .ClearContents End With If Not IsEmpty(rCrit) Then Dim i As Long For i = LBound(rCrit) To UBound(rCrit) f.Cells(startRow + i, startCol).Value = rCrit(i, 1) f.Cells(startRow + i, startCol + 1).Value = rCrit(i, 2) Next i End If End If CleanExit: End Sub قم تطبيق الفكرتين على نفس الملف لتختار ما يناسبك أيام الشهر من يوم محدد vba.xlsb

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

وعليكم السلام ورحمة الله وبركاته الاستاذ محمد هشام في المشاركة السابقة اخبرك (في حالة كنت تستخدم إصدار قديم لن تشتغل معك الصيغ. أخبرني بذالك لمحاولة إنشاء دالة أو كود vba ينفذ نفس المهمة) حسب ملفك الحالى كود في حدث الورقة كلما تم التغيير في M2 يتم التغيير في الاعمدة الملف أيام الشهر من يوم محدد - vba (1).xlsm

السلام عليكم بعد اذنكما محاولة حسب فهمى لطلبك فى الملف المرفق باول مشاركة عن طربق الكود في حدث الورقة الكود Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("C2")) Is Nothing Then Me.Range("A5:B" & Me.Rows.Count).ClearContents Dim monthYear As Date Dim firstDay As Date Dim lastDay As Date Dim currentDay As Date Dim outputRow As Long monthYear = Me.Range("C2").Value firstDay = DateSerial(Year(monthYear), Month(monthYear), 1) lastDay = DateSerial(Year(monthYear), Month(monthYear) + 1, 0) Dim startDay As Date startDay = firstDay Do While Weekday(startDay, vbSunday) <> vbSunday startDay = startDay + 1 Loop outputRow = 5 For currentDay = startDay To lastDay If Weekday(currentDay, vbSunday) <= 5 Then Me.Cells(outputRow, 2).Value = currentDay Select Case Weekday(currentDay, vbSunday) Case 1 Me.Cells(outputRow, 1).Value = "الأحد" Case 2 Me.Cells(outputRow, 1).Value = "الإثنين" Case 3 Me.Cells(outputRow, 1).Value = "الثلاثاء" Case 4 Me.Cells(outputRow, 1).Value = "الأربعاء" Case 5 Me.Cells(outputRow, 1).Value = "الخميس" End Select outputRow = outputRow + 1 End If Next currentDay End If End Sub الملف أيام الشهر من يوم محدد.xlsb

شكرا لكم اثريتم سؤالي لكن استاذ محمد @محمد هشام. دالة الاسماء تعمل جيدا على قوقل شيت لكن كيف اجعل الداله الاخرى تعمل على جوجل شيت و عذرا للإطاله وجدت الحل و شكرا لكم

متشكره جدا استاذ موسى بجد انت قمه فى الابداع بس انا فى حاجه مش فاهماهه هو ليه حضرتك عملت مربعات نص فى الاماكن الفارغه وكمان مش مفروض احط فى الاعدادات لكل مربع نص فى حقل التاج العلامه دى * عشان يطبق الكود على الحقول اللى فيها التاج دا ولا انا فاهمه غلط

حركة جميلة بضبط ارتفاع العناصر .. أبدعت أستاذ موسى

اهو جالك المبدع استاذي @Moosak وجاب ليكي الحل من ديله ابداع ابداع استاذي موسي

استاذه صافي السلام عليكم حضرتك عارفه النظام فى المنتدي هنا واكيد لو حد معاه معلومه لن يبخل بها عليكي انا عن نفسي والله ما اعرف لكن بدور فى الانترنت يمكن اجد حاجه لكن مش متأكد من امكانية اذا ممكن ام لا فانا هكون معاكي منتظر رد احد من اساتذتي الكرام 😁 اذا كان هناك حل او فكره ممكنه

انا قاعد مستني على فكره فيلا شد حيلك كده واطلعلنا بالشغل النار

مهندسنا الغالي ،، لولا المسافة ولا أبشروا بأحلى منسف 😇 التصميم للأمانة منقول مع إجراء تعديلاتي حسب حاجتي . أما سر الخلطة في الأكواد فهي مجرد خربشات 🤪 يسعدني تعليقاتك ومن قام بالتجربة حتى أطور على هذه التجربة للأفضل 🤭

نعم اخي @سعيد بيرم سنقوم بتعديل المعادلات لإستخراج الأيام والتواريخ بداية من يوم الأحد من كل شهر مع تجاهل يوم الجمعة والسبت الخلية (A5) =IF(C2="", "", FILTER(CHOOSE(WEEKDAY(FILTER(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <= 5) * (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <> 7) * (SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1) >= C2 + (7 - WEEKDAY(C2, 1)))), 1), "الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس"), WEEKDAY(FILTER(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <= 5) * (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <> 7) * (SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1) >= C2 + (7 - WEEKDAY(C2, 1)))), 1))) الخلية (B5) =IF(C2="", "", FILTER(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <= 5) * (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <> 7) * (SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1) >= C2 + (7 - WEEKDAY(C2, 1))))) او =IF(C2="", "", FILTER(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, EDATE(C2, 0), 1), (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, EDATE(C2, 0), 1), 1) < 6) * (SEQUENCE(DAY(EOMONTH(C2, 0)), 1, EDATE(C2, 0), 1) >= EDATE(C2, 0) + (7 - WEEKDAY(EDATE(C2, 0), 1))))) قم بتنسيق عمود التاريخ بما يناسبك ستظهر لك قائمة بأيام الشهر بدءا من أول يوم أحد وتجاهل يومي الجمعة والسبت لإستخراج عدد الأيام المتبقية في الشهر المحدد في الخلية (C2) =IF(C2="", "", COUNTA(FILTER(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <= 5) * (WEEKDAY(SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1), 1) <> 7) * (SEQUENCE(DAY(EOMONTH(C2, 0)), 1, C2, 1) >= C2 + (7 - WEEKDAY(C2, 1)))))) بالتوفيق ........ في حالة كنت تستخدم إصدار قديم لن تشتغل معك الصيغ. أخبرني بذالك لمحاولة إنشاء دالة أو كود vba ينفذ نفس المهمة أيام الشهر من يوم V2 محدد.xlsx

هل هذا طلبك ......