ehabaf2

السلام عليكم الاساتذة الافاضل كنت محتاج اعدل نطاق كود علشان هغير منطقة التسجيل المدى الحالى يبداء من العمود A اريد تعديل المدي ليبداء من العمود ِAL6 السطر رقم 6 و لو ممكن حد يشرح لى الكود يعرفنى كل سطر معناه ايه بحيث لو حبيت اعدل بعد ذلك و الف شكر لحضراتكم Sub test() Dim x& Dim r As Range Dim v, fnd Dim t As String x = Columns(1).Cells.Find(Range("N6"), , , 1).Row Range("N8") = Cells(x, 2) Set r = Cells(x, 1 + Split(Range("N4").Text, "-")(0) * 1).Resize(, 1 + Split(Range("P4").Text, "-")(0) * 1) With r On Error Resume Next Set fnd = .Find("Ã", , , 1) v = fnd.Address If Not fnd Is Nothing Then Do t = IIf(t = "", Cells(2, fnd.Column).Text, t & "+" & Cells(2, fnd.Column).Text) Set fnd = .FindNext(fnd) Loop Until v = fnd.Address End If Range("R8") = t t = "" Set fnd = .Find("Û", , , 1) v = fnd.Address If Not fnd Is Nothing Then Do t = IIf(t = "", Cells(2, fnd.Column).Text, t & "+" & Cells(2, fnd.Column).Text) Set fnd = .FindNext(fnd) Loop Until v = fnd.Address End If Range("R10") = t End With End Sub

الاستاذ الفاضل محى الدين ابو البشر الف شكر لحضرتك الكود يعمل و ينفذ المطلوب الف الف شكر لحضرتك و استاذنا الفاضل ابراهيم الحداد الف شكر لحضرتك زادكم الله من علمه و فضله و حفظكم بحفظه

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

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

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

السلام عليكم الاساتذة الافاضل ارجو من حضراتكم المساعدة فى عمل كود أو معادلة تفصل الارقام عن الحروف فى رسالة تحويل فودافون كاش مرفق ملف للتوضيح و الف شكر لحضراتكم رسائل كاش.xlsx

الاستاذ أ / محمد صالح الف الف شكر لحضرتك التعديل ممتاز فعلا كنت عاوز ينفذ الكود عن غلق الملف بالكامل و جربنته شغال تمام الف الف شكر لحضرتك ربنا يحفظك و يعزك و يبارك فيك

السلام عليكم محتاج تعديل الكود التالى لعمل نسخة احتياطية للملف و ينفذ عند غلق ورقة العمل و شكرا لحضراتكم Sub copy1() Dim Extension$ Dim savePathName As String Extension = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "Backup" & (Format(Now, " dd-mm-yyyy,hh.mm.ss AMPM")) & ".xlsm" savePathName = "Z:\ÇáÊÞæíã\ehab Share\ÈÑäÇãÌ 2023\" On Error Resume Next Application.DisplayAlerts = False GetAttr (savePathName) Select Case Err.Number Case Is = 0 Application.DisplayAlerts = False ThisWorkbook.SaveCopyAs savePathName & Extension Application.DisplayAlerts = True Case Else MkDir savePathName ThisWorkbook.SaveCopyAs savePathName & Extension End Select On Error GoTo 0 End Sub

ارجو من السادة الخبراء الافاضل المساعدة فى كود ترحيل الطلاب الضعاف و لكم جزيل الشكر

السلام عليكم الاساتذة الافاضل بعد اذن حضراتكم محتاج كود استخراج درجات الطلاب الضعاف اقل من 65 % فى شهر 10 أو 11 أو 12 مرفق ملف للتوضيح نطاق البيانات من العمود HF الى العمود IQ مكان استخراج البيانات من العمود KL الى العمود KY و الدرجة الخاصة بالمادة مكتوبة فى السطر 4 عند تنفيذ الكود يستخرج بيانات الطالب الحاصل على اقل من 65 % يعني اقل من الدرجة المكتوبة فى السطر الرابع تحت كل مادة بحيث يكتب جميع بيانات الطالب بما فيهم الدرجة الاقل من 65 % الى مكتوبه فى السطر الرابع الف شكر لحضراتكم و لجروب اوفيسنا المجترم الطلاب اقل من 65.xlsx

الاستاذ الفاضل ابا اسماعيل الف شكر لحضرتك بارك الله فيك الكود يعمل و ينفذ المطلوب زادك الله من علمه و فضله

السلام عليكم الاساتذة الافاضل انا عملت ماكرو عبارة عن فلتر متقدم بستعلم منه عن البيانات Sub Macro901() ' ' Macro901 Macro ' ' Range("DF4").Select Columns("AM:BD").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "'ÇáÊÓÌíá (2)'!Criteria"), CopyToRange:=Range("'ÇáÊÓÌíá (2)'!Extract"), _ Unique:=False Range("DC3:DT3").Select End Sub فهل من الممكن عمل كود VBA يقوم بعمل الكود السابق و يكون اسرع مرفق ملف للتوضيح الف شكر لحضراتكم تعديل كود.xlsm

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

الاستاذ الفاضل حسونه حسين الف شكر لمجهود حضرتك و لكن الكود بيعطي هذه الرسالة run-time error 9

الاستاذ الفاضل lionheart الحمدلله حمدا كثيرا طيبا مبارك فيه عرفت اعدل الكود و كنت فى قمة السعادة لانني عرفت اعدل الكود و الكود اشتغل و نفذ المطلوب بشكل رائع سلمت يداك و زادك الله من فضله و علمه الف الف شكر لجميع السادة الاساتذة الافاضل و القائمين على الموقع ملحوظة انا لم استخدم هذا الجزء و لم اعرف فيما يستخدم Application.Goto .Range("AM" & m), True

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

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

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

كود الاستاذ الفاضل حسونه حسين و هو ينفذ المطلوب بشكل احترافى Option Explicit Sub CClose() Dim Ws As Worksheet, RangeArea As Range, C As Range, MergedRange As Range kh_Application False Set Ws = ThisWorkbook.ActiveSheet With Ws Set RangeArea = .Range(.Cells(1, 1).Address, .Cells(653, IIf(ActiveCell.Column = 1, 1, ActiveCell.Column - 1)).Address) .Unprotect Password:="1" If ActiveCell.Row <= 653 Then For Each C In RangeArea If C.MergeCells = True And C.MergeArea.Rows.Count = 1 Then Set MergedRange = C.MergeArea MergedRange.UnMerge MergedRange.HorizontalAlignment = xlCenterAcrossSelection End If Next C RangeArea.Locked = True End If .Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True End With kh_Application True End Sub Sub COpen() kh_Application False ActiveSheet.Unprotect Password:="1" If ActiveCell.Row <= 653 Then Range(Cells(1, 1).Address, Cells(653, ActiveCell.Column).Address).Locked = False End If ActiveSheet.Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True kh_Application True End Sub Sub kh_Application(ibol As Boolean) With Application .ScreenUpdating = ibol .Calculation = IIf(ibol, -4105, -4135) .EnableEvents = ibol End With End Sub الف شكر استاذنا الفاضل حسونه حسين على تعبك و اهتمامك زادكم الله من فضله و علمه

السلام عليكم الاساتذة الكرام محتاج كود ترحيل تقيم الطلاب من جدول الى جدول اخر مرفق ملف التقيم ترحيل ورش.xlsx

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

الف الف شكر استاذنا الفاضل أ / محمد صالح الف الف شكر استاذنا الفاضل أ / على بن على تعديل الكود رائع و يعمل جيدا زادكم الله من فضله و علمه

السلام عليكم السادة الخبراء رجاء المساعدة فى تعديل الكود التالى لكي يعمل على الصفوف ارقام من 9 الى 21 فقط و باقى الشيت لا يشمله الكود Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Unprotect "45" Target.Locked = True ActiveSheet.Protect "45" End Sub مرفق ملف للتوضيح شكرا جزيلا كود حماية.xlsm

السلام عليكم الاساتذة الافاضل كنت بسئل هل ممكن عمل كود VBA عند تنفيذه يتم غلق الخلايا فى النطاق من العمود B السطر رقم1 حتى السطر رقم 653 فى العمود النشط يعني العمود اللى فيه الخلية النشطة ارجو ان اكون قدرت اعبر عن المطلوب كود قفل نطاق محدد.xlsx

السلام عليكم استاذنا الفاضل محي الدين ابو البشر بارك الله فى حضرتك و متعك بالصحة و العافية و زادك من علمه و فضله الحمد لله الكود يعمل بشكل رائع و هو المطلوب اكرر شكرى لحضرتك