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

مرحبا أخي @عبدالعزيز محمد 🙂 أنشأت لك هذه الدالة ، تأخذ الرقم القومي فتقوم بطرح سنة الميلاد من السنة الحالية للحصول على عمر الطالب بالسنوات .. بعدها يتم توزيع الطلاب على مراحلهم بناءا على العمر ، وطبعا سوف تتغير المرحلة تلقائيا في الأعوام القادمة لأن الدالة تحسب العمر تلقائيا 🙂 Public Function AutoStage(IDNum As String) As String Dim bYear As Integer bYear = CInt(Mid(IDNum, 2, 4)) 'تستخلص سنة الميلاد من الرقم القومي bYear = Year(Date) - bYear ' تطرح سنة الميلاد من هذا العام لمعرفة العمر الحالي 'Debug.Print bYear 'توزيع المرحلة على حسب العمر الحالي للطالب Select Case bYear Case Is = 3: AutoStage = "حضانه" Case Is = 4: AutoStage = "روضه" Case Is = 5: AutoStage = "تمهيدي" Case Is = 6: AutoStage = "الأول" Case Is = 7: AutoStage = "الثاني" Case Is = 8: AutoStage = "الثالث" Case Is = 9: AutoStage = "الرابع" Case Is = 10: AutoStage = "الخامس" Case Is = 11: AutoStage = "السادس" Case Is = 12: AutoStage = "السابع" Case Is = 13: AutoStage = "الثامن" Case Is = 14: AutoStage = "التاسع" Case Is = 15: AutoStage = "أول ثانوي" Case Is = 16: AutoStage = "ثاني ثانوي" Case Is = 17: AutoStage = "ثالث ثانوي" Case Else: AutoStage = "" End Select End Function ثم وضعتها في مربع نص (محسوب) مصدره الدالة التي تغذيها بالرقم القومي فتحسب لك تلقائيا المرحلة .. ملاحظة : ( تحتاج أن تضع في الحسبان حالات الرسوب وإعادة السنة الدراسية ) 🙂 Aziz(Moosak).zip

موضوع ثري ما شاء الله تبارك الرحمن 🙂 الله يوفقك عمي جعفر ويطول ويبارك في عمرك 🌹

تفضل 🙂 . جعفر

شكرا اخوي محمد 🙂 الآن عرفنا وين الخطأ !! اخونا الشربيني كان واضع كل كائنات امر الطباعة خطأ 🙄 جعفر

اخى واستاذنا الفاضل @Ali Mohamed Ali للرفع رفع الله قدركم

أوقات الصلاة

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

@rockjone33 هل بالإمكان ان يكون اسم قاعدة البيانات تلقائي من المسار مباشر فلو كانت قاعدة البيانات DBtest.acccdb يتم تعريف اسم قاعدة البيانات الذي يكتب يدويا فيسجل DBtest مع وضع زر للسماح بالتعديل عند الحاجة

Sub MH_hyperkunks() Dim Ws As Worksheet Worksheets("toutal").Range("A3:a100").ClearContents Range("A3").Select For Each Ws In ActiveWorkbook.Worksheets If Ws.Name <> "toutal" Then ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:="" & Ws.Name & "!A1" & "", ScreenTip:="", TextToDisplay:=Ws.Name ActiveCell.Offset(1, 0).Select End If Next Ws End Sub mango2023(1).xlsm

تفضل جرب ادخل هذا التاريخ فقط ثم جرب تصفيات اخرى مع التاريخ T4Q - Copy.rar

تمام انتظرني .. سوف اعمله لك بالاستعلام بدون دالات ان شاء الله

تفضل اخي مثال توضيحي.xlsx

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

السلام عليكم ورحمة الله وبركاته .. اليوم جايب لكم موقع وظيفته يقرأ أو يشرح لك الكود بلغة إنجليزية مفهومة ، ويمكنك عن طريق المترجم تحويلها إلى اللغة العربية 🙂 وهذا هو الموقع : https://denigma.app الموقع بفضل الله يتعامل مع معظم اللغات البرمجية تقريبا ، ومن ضمنها الفيجوال بيسك VBA .. وهذا شرح مبسط للاستخدام .. بعد فتح الموقع ننزل تحت إلى هذي الخانة، يوضع الكود في الخانة اليسرى ويظهر التفسير في الجهة اليمنى : نجرب نلصق دالة حساب العمر بالسنة والشهر واليوم ونضغط على [Explain it!] : ولترجمته باللغة العربية ، تأخذ النص لمترجم جوجل فيعطيك النتيجة هكذا : 🙂 هذا وسلامتكم ☺️🌹

جزاك الله خيرا يا صديقي

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

Sub change_selection() Dim MH_Range, New_Range As Range Set MH_Range = Selection Set New_Range = MH_Range.Resize(, 1).Offset(0, MH_Range.Columns.Count) New_Range.Select End Sub تحديد صف موازى لنطاق.xlsm

السلام عليكم أخي الكريم @ayman ahmed أرأيت إن أرفقت ملفاً تعرض من خلاله المشكلة التي واجهتك بما يخص التعامل مع هذه الدالة، سيكون المجال أرحب وأفضل من هذه الأسطر التي شرحت لأن من سيجيبك سيعمل على التخمين فإما أن تصيب أو تخيب.... من هذه التخمينات مثلاً: هل تم تحديد البيانات المراد البحث من خلالها باستخدام مفتاح F4 ؟. =VLOOKUP(A2;$B$2:$C$5;2;0) ماهو تنسيق الخلايا الذي ستدرج الإجابة فيها (نص - عام - رقم ...إلخ...). الملف الأصلي غير مطلوب إحضاره ،أو إرفاقه بل المطلوب ملف مماثل ببيانات وهمية تحقق لمن يريد المساعدة إمكانية التعامل بشكل أمثل مع طلبك ليتسنى لك تطبيق الحل على ملفك الأصلي بكل سهولة ، بمعنى كم عدد الأعمدة لهذه الورقة أو تلك، مع تنسيق يشبه تنسيق الملف لديك.. هذا والله أعلم. والسلام عليكم

منك العذر أستاذنا محمد @Barna تطفلت عليكم 😅 ما ركزت في ردك ، عملت الطريقة بسرعة قبل لا تطير الفكرة من راسي 😁 وهذي فكرة أخرى جميلة ، من مفكر عبقري 😉👌

عمل جميل استاذنا موسى وكذلك عمل الاستاذ مجمد البرناوي ⬇️ Me.CLASSE = Switch([mo] = 6, "الأول", [mo] = 7, "الثاني", [mo] = 8, "الثالث", [mo] = 9, "الرابع", [mo] = 10, "الخامس", [mo] = 11, "السادس") بالنسبة لي لو اني مازلت مبرمج فسوف اعمل بطريقة اخرى عن طريق وضع هذه القيم في جدول باعتبارها قيم ثابتة تحياتي

Sub test() Dim a As Variant, lr, i, x, s, k, itm a = Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 7) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then If a(i, 7) = Sheets(2).Range("C1") Then .Add a(i, 1), a(i, 7) End If Next Sheets(2).Cells(10, 1).Resize(.Count, 2) = Application.Transpose(Application.Index(Array(.keys, .items), 0, 0)) End With End Sub أو Sub test() Dim a As Variant, lr, i, x, s, k, itm a = Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 7) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then If a(i, 7) = Sheets(2).Range("C1") Then .Add a(i, 1), "" End If Next Sheets(2).Cells(10, 1).Resize(.Count) = Application.Transpose(.keys) End With End Sub

شاهد هذا الموضوع

اخي @الشربيني 123 من يستحق افضل اجابة هي اجابة استاذي الفاضل @jjafferr بارك الله بك وبه .....

السلام عليكم و رحمة الله بارك الله فيك اخى الكريم / حسونة لفد وضعت هذه المشاركة فى منتدى الاكسل الذى لم اتخلى من من متابعته طوال حوالى 10 سنوات و شاركت فيه لما يربو عن ال 8 سنوات و حزنت عندما وجدت ان موضوعى هذا قد اختفى و بدأت ابحث فى باقى الاقسام و التى ازورها لاول مرة منذ اشتراكى فى هذا المنتدى المهم اخيرا وجدت موضوعى و ردكم الكريم عليه بالفعل اخى الكريم بالعودة على بريدى الالكترونى وجدت زر مكتوب عليه هذه العبارة "Review Activity & Secure Account" و بالضغط عليه دخلت الى صفحة كلها باللغة الانجليزية لم افهم منها شيئا و مازال اسمى على هو "اكسلنا" من اكسلنا هذا ؟ ... الله اعلم اخى الكريم رجاءا اريد الطريقة التى استطيع من خلالها استعادة عضوية الحقيقية و هى ابراهيم الحداد لقد حرمت من ان اطلع على موضوعاتى السابقة و التى تعد بالعشرات الى عضو صفرى و كأنى مازلت جديدا و لم اشارك فى اى موضوع مسبقا عذرا على الاطالة اشعر بوجع و كأنى فقدت انسانا عزيزا على و هذا بريدى الاكترونى مرة اخرى : ibrahim200058@yahoo.com اخيك / ابراهيم الحداد

تفضل <><><><><> On Error Resume Next DoCmd.OpenReport "R1", acViewReport, , "[المؤهل]=" & Me.HA & " and [النوع]=" & Me.SI DoCmd.Close acForm, Me.Name

. . جعفر

السلام عليكم ورحمة الله وبركاته الدخول يكون عن طريق الاميل استاذنا الفاضل @ابراهيم الحداد مفروض كده تم ارسال رساله لك على الميل سواء كان Gmail Yahoo Hotmail

عملت لك نموذج واسعلام النموذج : frmRseedSabeq والاستعلام : qryRseedSabeq اخفيت حقل تاريخ الى وحقل آخر حتى لا يحصل خلط وتشتيت يمكنك الآن التصفية حسب اختياراتك من الحقول مصدر التمويل لوحده .. او تضم معه الحساب او نوعه ، او الحساب فقط او نوعه فقط اذا اردت جميع التي قبل التاريخ المحدد بدون استثناء : اكتب التاريخ فقط اتمنى ان يحقق مطلوبك T3Q -6.rar

جرب اذا ناسبقك ..... تأكد من الاعمار لديك واكمل حتى تتعلم الكود ...... Aziz (2).zip

أخي الكريم @Mohammed Alsakka : السلام عليكم وبعد: تقوم بعمل تصفية لكل ما هو مسجل بالتاريخ الهجري، ثم تنتقل إلى مربع حوار تنسيق خلايا تبويب تنسيق الأرقام ......... تخصيص: تضع التنسيق التالي للتحويل إلى ميلادي: [$-,201]yyyy-mm-dd;@ بدلاً من: [$-,197]B2yyyy-mm-dd;@ وهكذا.... والسلام عليكم

السلام عليكم اتفضل استاذ @marwa41 ان شاء الله يكون ما تريد سيتم انشاء ملف pdf باسم الشيت اللى انت موجود فيه والمجلد فى اى مكان فى الجهاز Sub print_pdf() ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Application.ActiveWorkbook.Path & "\printpdf\" & ActiveSheet.Name & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True End Sub بالتوفيق Data.rar

السلام عليكم تفضل أخي جرب الكود التالي Sub dataselect() T = [D21] ' Target Number [B:B].Interior.ColorIndex = xlNone LR = [B99999].End(xlUp).Row For r = 2 To LR - 1 Sm = Cells(r, 2) For j = r + 1 To LR Sm = Sm + Cells(j, 2) If Sm > T Then GoTo 10 If Sm = T Then GoTo 20 Next j 10 Next r Exit Sub 20 Range(Cells(r, 2), Cells(j, 2)).Interior.ColorIndex = 4 Cells(r, 3).Select MsgBox "Rows from " & r & " to: " & j End Sub وهذا المرفق به الكود SUM.rar