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

أخى محمد جرب الكود التالى Sub ragab() Dim cl As Range, LR As Integer Dim sh As Worksheet, R_N As Integer Set sh = ورقة3 '=========================================== Application.ScreenUpdating = False x = [G13] LR = sh.[G1000].End(xlUp).Row + 1 Range("A13:K13").Copy For Each cl In sh.Range("G13:G" & LR) If cl = x Then R_N = cl.Row sh.Cells(R_N, 1).PasteSpecial xlPasteValues GoTo 1 End If Next sh.Cells(LR, 1).PasteSpecial xlPasteValues 1: Application.CutCopyMode = False Application.ScreenUpdating = True End Sub ترحيل.rar ترحيل.rar

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أخي الغالي على الكلمات الطيّبة و الشّعور النّبيل تجاه منتدانا الحبيب "أوفيسنا" .. و في الواقع الاعتراف و العرفان بالجميل ..شيء جميل بحد ذاته فعلاً ..منتدى رائع بروعة أساتذته الأفاضل .. من بينهم أساتذتي الأعزّاء .. بالطّابق العلوي الذين سبقوني بمشاركاتهم بموضوعك هذا .. و كتشجيع لك وعرفان مني بالجميل .. أعترف مخلصًا أمام الله أنّ ياسر خليل أبو البراء مختار حسين محمود بن علية حاجي الصّقر ياسر العربي محمد حسن المحمد و كذلك كثير من الأساتذة الجديرين بالحب و التقدير و الاحترام هؤلاء هم ..سبب تمسّكي بعالم الاكسيل المثير و أعطوْا لأوقاتي أكثر من معنى بارك الله فيهم و لهم ..جزاهم الله خيرًا و زادها بميزان حسناتهم إحتراماتي

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله مع التحديث الجديد .. للأسف لم أجد التوجيهات التي تم وضعها من قبل ، وهذه القواعد والأسس هامة جداً ليدرك الأعضاء كيفية التعامل مع المنتدى طبعاً الموضوع سيكون متجدد .. سيتم وضع القواعد مرة أخرى فالرجاء الرجاء أن تساعدوني في اتمام الأمر .. كل عضو يذكرني بتوجيه من هذه التوجيهات ليتم إرساء القواعد ، إذ أن نجاح أي مؤسسة يعتمد في المقام الأول على قواعد ومنهج ثابت للسير على دربه التوجيهات والقواعد التي يجب مراعاتها التوجيه الأول : قبل طرح موضوع جديد يتعلق بطلب محدد يرجى استخدام خاصية البحث أولاً ، فإذا لم يجد طارح الموضوع بغيته ، فعليه أن يقوم بطرح موضوع جديد ، وفي هذه الحالة على طارح الموضوع أن يعلم أن حسن السؤال شطر الإجابة ، فاللباقة واللياقة والكياسة من الصفات التي يجب أن يتحلى بها طالب العلم. التوجيه الثاني : عند طرح موضوع جديد ، يتم وضع عنوان مناسب للطلب بحيث يفهم الطلب قبل الإطلاع عليه ، وعلى طارح الموضوع أن يبتعد عن العناوين الغير مجدية مثل : ( طلب مساعدة - الرجاء المساعدة - ساعدوني من فضلكم - عاجل وهام - الحقوني - نداء للعباقرة - نداء للعمالقة - إلى آخر تلك العناوين ...) ، وأمر آخر ألا يكون العنوان على شكل سؤال أو طلب .. نبتعد عن كلمة "طلب" مثال تطبيقي : نفترض أنني أريد معادلة تجمع القيم في عمودين العنوان المناسب للطلب يكون بهذا الشكل : معادلة جمع القيم في عمودين والنتائج في عمود آخر التوجيه الثالث : أن يتم توضيح المطلوب بالموضوع بشكل يزال معه أي لبس ، وفي نفس الوقت يراعى الإجمال في الطلب ، فأقصر الخطوط هو الخط المستقيم ، بمعنى "لا إطالة مملة ولا اختصار مخل" ، أي لا يكون طرح الموضوع مختصر للغاية بل يجب أن يستوفي جميع العناصر المطلوبة ، ومن ضمنها أن يحدد طارح الموضوع هل الحل المطلوب بالمعادلات أم بالأكواد أم بكلاهما لتكون الأمور واضحة بالنسبة لمن يريد تقديم المساعدة ، وأن يقوم صاحب الموضوع بإرفاق ملف به بيانات وهمية لتوضيح طلبه وللوصول إلى حل سريع ودقيق ، وإذا صعب على طارح الموضوع شرح المطلوب يمكنه إرفاق بعض النتائج المتوقعة كي يسهل الوصول لحل. التوجيه الرابع : نلاحظ أن شكل المنتدى لا يعجب معظم الأعضاء ، فلما لا نغير بأيدينا الشكل العام للمشاركات ، فيفضل على سبيل المثال استخدام حجم خط كبير 22 على سبيل المثال وجعل الخط عريض Bold مما يجعل المشاركة واضحة ومقروءة بشكل جيد ، كما يمكن استخدام الألوان أي قم بتنسيق المشاركة بشكل جذاب يجعل القاريء لا ينفر منها. التوجيه الخامس : بعد الانتهاء من الموضوع والوصول لحل يرضي صاحب الموضوع ، يرجى أن يتم تحديد أفضل إجابة من خلال النقر على علامة الصح الموجودة بجانب كل مشاركة ، وأن يسجل صاحب الموضوع إعجابه من خلال النقر على "سجل اعجاب بهذا" كنوع من رد الجميل لمن قدم المساعدة ، ويمكن أيضاً أن يقوم بتقييم المشاركة تقييم إيجابي كنوع من التقدير ، وأن تشكر من قدم المساعدة فمن لم يشكر الناس لا يشكر الله. فيما يخص لو كان هناك أكثر من إجابة للموضوع ، يمكن لصاحب الموضوع عمل مشاركة جديدة يجمع فيها كل الحلول ويختار هذه المشاركة كأفضل إجابة التوجيه السادس : لا تكن لحوحاً ، يكفي أن أعضاء المنتدى يقدمون وقتهم و خبرتهم مقابل لا شيء وعندهم أعمال أخرى (مشاغلهم الخاصة) يقومون بها ، و إذا تأخر الرد ، فمن الممكن أن يكون أحد الأعضاء يقوم بمحاولة الإجابة ، وهذا يستغرق بعض الوقت خاصةً إذا كان الموضوع صعباً. التوجيه السابع : حمل الملف المرفق دون زركشات (ألوان و تنسيقات مختلفة) مما يزيد من حجم الملف و أحياناً تكون الألوان مقززة بشكل ينفر منها المساعد (خاصةً إذا كانت ألوان الخلايا غير متناسقة مع لون الخط) التوجيه الثامن : تأكد أن الملف المرفوع غير مصاب بفيروس و غير محمي بكلمة سر ، وإلا لن تجد المساعدة من قبل الأعضاء. التوجيه التاسع : متابعة صاحب الموضوع لموضوعه والتفاعل معه ، فلا يعقل أن يطرح أحدهم موضوع ولا يتابعه إلا بعد مرور وقت طويل ، فهذا يعد من اللامبالاة الغير مرغوب فيها ، والتي تنفر الجميع من العضو. التوجيه العاشر : عدم التسجيل في المنتدى بأكثر من حساب ، وأن يكون اسم الظهور باللغة العربية ومعبر عن الاسم الحقيقي أي (تعريب اسم العضو) ، فلا يجوز أن يكون اسم الظهور اسم واحد وفقط بل أن يكون ثنائي على الأقل أو أن يكون اسم ولقب ، ولذا يرجى عدم استخدام الأسماء المستعارة أو الأسماء باللغة الأجنبية ، فاللغة العربية هي هويتنا ولابد من الحافظ عليها. ** يتم تغيير اسم الظهور أو اسم المستخدم من خلال إعدادات الحساب ثم التبويب اسم المستخدم ، قم بتغيير الاسم ثم انقر كلمة حفظ التوجيه الحادي عشر : عدم طرح أكثر من موضوع لنفس الطلب من نفس العضو ، فهذا يعد مخالفة صريحة ، وليعلم العضو الذي يقوم بذلك أن تكرار الموضوع لن يجدي نفعاً في حالة عدم توضيحه للمطلوب. وفي حالة أن قام العضو بذلك عن طريق الخطأ يقوم العضو بالتنويه في الموضوع وطلب حذف الموضوع نظراً لتكراره. التوجيه الثاني عشر : على من يقدم المساعدة أن يكون مثالاً يحتذى به في العطاء والصبر والحلم وكرم الأخلاق وحسن الإجابة ، يجتذب بتلك الصفات عقول الآخرين وأفئدتهم التوجيه الثالث عشر : عند طرح موضوع يفضل أن يكون هناك طلب واحد فقط إذ أن الموضوع الذي تكثر فيه الطلبات ينفر الأعضاء الذين يريدون تقديم يد المساعدة ، وعلى رأي المثل (من يطارد عصفورين يفقدهما) فما بالك لو طاردت أكثر من طلبين أقصد أكثر من عصفورين ، يمكنك أن تتعامل بذكاء بأن تطرح الموضوع بطلب واحد حتى إذا تم على خير قم على الفور بطرح موضع جديد بطلب جديد وهكذا إلى أن يتم الأمر التوجيه الرابع عشر : يرجلا عدم إرسال رسائل خاصة للأعضاء لطلب المساعدة بشكل شخصي ، لأن هذا الأمر يضايق الكثير من الأعضاء ، وتأكد أن العضو إذا كان لديه معلومة أو يستطيع أن يفيد بشيء ووقته يسمح بذلك فلن يتأخر عنك ، يكفي أن تكتب كلمة "للرفع" في موضوعك ، ليشاهده أكبر عدد من الأعضاء. ** كيفية رفع الصور في المشاركات : ******************************* دمتم على طاعة الله

برنامج تسجيل التحاليل الطبية ************************ برنامج مجانى لكل مريض و لكل طبيب يعالج مرضاه بالمجان ************************************************* رابط شرح البرنامج https://www.youtube.com/watch?v=szAFJNL2CEU&feature=youtu.be ************************************************ رابط تحميل Microsoft Access 2010 Runtime https://www.microsoft.com/en-us/download/details.aspx?id=10910 ****************************************************** رابط تحميل برنامج تسجيل التحاليل الطبية http://www.mediafire.com/download/yf7bh9mmiy3f8hr/%D8%AA%D8%B3%D8%AC%D9%8A%D9%84+%D8%A7%D9%84%D8%AA%D8%AD%D8%A7%D9%84%D9%8A%D9%84+++.accdb ****************************************************** اسم المستخدم : الحمد لله كلمة السر : الحمد لله برنامج تسجيل التحاليل الطبية ************************ برنامج مجانى لكل مريض و لكل طبيب يعالج مرضاه بالمجان ************************************************* رابط شرح البرنامج https://www.youtube.com/watch?v=szAFJNL2CEU&feature=youtu.be ************************************************ رابط تحميل Microsoft Access 2010 Runtime https://www.microsoft.com/en-us/download/details.aspx?id=10910 ****************************************************** رابط تحميل برنامج تسجيل التحاليل الطبية http://www.mediafire.com/download/yf7bh9mmiy3f8hr/%D8%AA%D8%B3%D8%AC%D9%8A%D9%84+%D8%A7%D9%84%D8%AA%D8%AD%D8%A7%D9%84%D9%8A%D9%84+++.accdb ****************************************************** اسم المستخدم : الحمد لله كلمة السر : الحمد لله

مرورك بأي موضوع لي رد فيه شرف كبير لي أخي ومعلمي رجب جاويش فمكنم تعلمنا ومازلنا نتعلم .. جمعني الله وإياك في مستقر رحمته في الفردوس الأعلى من الجنان تقبل وافر حبي وتقديري وتحياتي

ونعم المعلم والمتابع أجمل تحياتى واحترامى للأستاذ ياسر خليل

أخي الحبيب ياسر العربي الفكرة مش ف الفك أنا عندي بدل الطريقة الواحدة عشر طرق ...بس نحب نستفيد من الجديد وبصراحة ملفك عجبني وإن شاء الله يظبط معاك أما بالنسبة لـ 32 بت ..فيبدو أنني قد هجرته تماماً ولم أعد أعمل عليه .. اللي خد ع الشغل العالي صعب يرجع تاني للشغل الضعيف أنا بالفعل مرتاح جداً في نسخة الـ 64 بت ويندوز 10 وأوفيس 2013 نسخة 64 بت وتعمل بكفاءة عالية تقبل تحياتي يا كبير

حبيبي الغالي ابو البراء رجع للعادة بتاعته تاني ماشي ياريس موضوع فك محرر الاكواد للامتدادت الاخرى تحت البحث طبعا وانت عارف الموضوع دا ان لسه بنبحث فيه يبقي كدا وقع النقطة الاولي النقطة التانية مجرب على معظم الامتدادات وفك الاوراق بدون مشاكل اما عندك مش شغال مش عارف ليه انا هنزل نسخة مخصوص 64 عشان خطرك بس لما النت يظبط معايا هحملها اتعب نفسك كدا وجربها على نسخة 32 كدا وبعدين اللي عاوز يفك ملف لو هخليه يحوله لمقطع صوتي هيحوله تقبل تحياتي وجاري ارفاق فيديو لطريقة عمل البرنامج فيديو طريقة العمل yasser vba.rar

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

وتكون النتيجة كما بالملف المرفق spin.rar

بعد اذن أخى الفاضل سليم ولاثراء الموضوع جرب أخى هذا الكود Sub ragab() Dim LR As Integer, LR1 As Integer, i As Integer, x As Integer Dim sh As Worksheet, cl As Range, TT As Integer, DD As Integer Set sh = Sheet1 '=================================================================== On Error Resume Next If IsEmpty(Range("C1")) Or Not IsNumeric(Range("C1")) Then Exit Sub TT = [C1] Range("A4:D1000").ClearContents LR = sh.Range("B1000").End(xlUp).Row - 1 DD = LR - Application.WorksheetFunction.CountIf(sh.Range("E2:E" & LR + 1), "ok") If DD = 0 Then MsgBox ("لا يوجد أسماء متاحة للاختيار منها") Exit Sub End If MsgBox ("عدد الأسماء المتاح الإختيار منها " & " " & DD) If TT > DD Then Exit Sub 1: x = Int(Rnd(1) * LR + 1) LR1 = Range("A1000").End(xlUp).Row '=================================================================== If sh.Cells(x + 1, 5) = "ok" Then GoTo 1 For Each cl In Range("A4:A" & LR1) If cl = x - 1 Then GoTo 1 Exit For End If Next '=================================================================== For i = 1 To 4 Cells(LR1 + 1, i) = sh.Cells(x + 1, i) Next sh.Cells(x + 1, 5) = "ok" R = R + 1 If R = TT Then Exit Sub GoTo 1 End Sub اسماء السائقين ومكان عملهم1.rar

عسى ان يكون المطلوب اسماء السائقين ومكان عملهم salim.rar

استاذى الفاضل / ابوالوليد اهلا وسهلا بيك بالمنتدى نورة بين اخوانك ان شاء الله تفيد وتستفيد على الرغم انى لم افهم جيدا ما تريد ولكن جرب المرفق لربما يكون طلبك تقبل تحياتى ====================================== المصنف1.zip

أخى الكريم // وجدى الحاج اثراء للموضوع ولمزيد من طرح الأفكار وبعد إذن أساتذتى الكرام ( أ/ جعفر & أ / ياسر خليل & أ/ ياسر العربي ) يوجد بالموقع العديد والعديد من الأفكار والأعمال الأكثر من رائعة لأساتذتى الذين تعلمت منهم ومازلت والتى يعد كل منها درسا فى عالم الفيجوال بيسك اكسل واليكم هذا الملف لعل يستفيد منه أحد الأعضاء وهو للأستاذ القدير // الحسامى - جعله الله فى ميزان حسناته وتقبلوا منى وافر الاحترام والتقدير جلب صور الحسامي.rar

استاذى العزيز مختار جزاك الله كل خير اخى وحبيبى ابو البراء بارك الله فيك وجعلكم عونا للمبتدئين امثالى وجزاكم الله عنا كل خير بالتوفيق اخوانى الكرام

أخي الكريم أبو هايدي ضع الأسطر التالية لتؤدي الغرض إن شاء الله Private Sub TextBox2_Change() If TextBox2 <> "" And TextBox3 <> "" Then TextBox4.Value = Val(TextBox2) / Val(TextBox3) Else TextBox4.Value = "" End Sub Private Sub TextBox3_Change() If TextBox2 <> "" And TextBox3 <> "" Then TextBox4.Value = Val(TextBox2) / Val(TextBox3) Else TextBox4.Value = "" End Sub

بسم الله الرحمن الرحيم بسم الله و الحمدلله و الصلاة و السلام على اشرف خلق الله سيدنا محمد و على آله و صحبة و من والاه أما بعد نظرا لكثرة السؤال عن فك الحماية اما لمحرر الاكواد او لورق العمل قمت بدمج الاكواد مع بعض التعديلات في ملف واحد للتسهيل على الاخوة فقط كل ما عليك هو ان تقر ان الملف خاص بك ولا يعد تعديا علي ملفات الغير يتم تفعيل الازرار الخاصة بكسر حماية محرر الاكواد واوراق العمل كسر حماية اوراق العمل يتم فكها جميعا كل ما عليك هو اختيار الملف والموافقه على بدأ الفك وانتظر حتى يكتمل فك الاوراق جميعا طبعا وقت الفك حسب مدى صعوبة كلمة المرور اما كسر محرر الاكود ما عليك الا ان تقوم باختيار الملف الهدف-xls- فتظهر لك رسالة خطأ بعدها يتم فتح محرر الاكواد ومنها تقوم باعادة تعيين كلمة اخرى والحفظ والسلام عليكم Hack VBA.rar

السلام عليكم ورحمة الله وبركاته من خلال الكود اريد معرفة رقم الصفحة الحالية او الصفحة الأخيرة بالتقرير السؤال بطريقة أخرة ما أريد فعله مثل هذا: ادا كانت لصفحة حالية = الصفحة الأخيرة اصنع كذا قمت بهذه المحاولة ولم تفلح If page = pages then وجزاكم الله خيرا

السلام عليكم ورحمة الله وبركاته كنت منذ فترة قدمت لحضراتكم موضوعا بعنوان : إغلاق آلى لملف اكسل إذا ترك بدون استخدام على الرابط التالى : http://www.officena.net/ib/index.php?showtopic=59908 واليوم أعرض على حضراتكم موضوعا شبيها كما يبدو من عنوان الموضوع : كيفية تشغيل كود ( أى كود ) إذا ترك ملف الاكسل بدون استخدام الطريقة : 1- ضع الكود التالى فى حدث الملف Private Sub Workbook_SheetActivate(ByVal Sh As Object) ResetTime ' كود اعادة المدة كلما حدث تنشيط شيت End Sub Private Sub Workbook_SheetCalculate(ByVal Sh As Object) ResetTime ' كود اعادة المدة كلما حدث تغيير فى البيانات End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) ResetTime ' كود اعادة المدة كلما حدث تغيير فى شيت End Sub ضع الكود التالى بمديول عادى Public MyTime As Date Sub Auto_Open() MyTime = Now + TimeSerial(0, 0, 30) ' بداية عمل الكود بعد فتح الملف Application.OnTime MyTime, "MyMacro" End Sub Sub CancelOnTime() Application.OnTime MyTime, "MyMacro", , False End Sub Sub ResetTime() On Error Resume Next Application.OnTime EarliestTime:=MyTime, Procedure:="MyMacro", Schedule:=False MyTime = Now + TimeSerial(0, 1, 0) ' المدة الزمنية التى يعمل بعدها كودك Application.OnTime EarliestTime:=MyTime, Procedure:="MyMacro" On Error GoTo 0 End Sub Sub MyMacro() ' ضع كودك الذى تريد تشغيله اذا لم يكن الملف نشطا ' مثال Shell "C:\WINDOWS\system32\Bubbles.scr /S", vbMaximizedFocus ' انه كودك بالأمر التالى ResetTime End Sub 3 - احفظ الملف و أعد فتحه طالما أنت شغال على الملف لن يعمل الكود اذا توقفت عن العمل ستبدأ الفترة الومنية التى يعمل بعدها كودك تحياتى لكم وأتمنى أن ينال الملف اعجابك المرفق : تشغيل آلى لكود إذا ترك الاكسل بدون استخدام.rar

السلام عليكم عندي نموذج به عدة حقول ، وأريد وضع زر ينسخ قيمة أحد القول في ذاكرة الجهاز لأستعمله في برنامج آخر ( بدلا من استخدام ctrl c ) شاكر ومقدر لهذا المنبع الثّر بعطاءه تحياتي الشاعر

سلمت يمينك وادام الله عليك الصحة والعافية وزادك الله من العلم الكثير والكثير تقبل تحياتى وتقديرى الملف المرفق امتداده xlsm كيف يفتح ملفات بامتداد xls

تمام معلمى الغالى وفعلا هما ملهمش لازمه لانى جربت الكود تمام ثانيا اعلم انه يجب تعريف المتغير بــ dim ولكن لقلة خبرتى فى تنسيق انواع المتغيرات فكتبتها هكذا وطالما انك عوننا لنا بعد الله اخى واخوانى الافاضل فإن شاء الله نستطيع التغلب على العقبات وفقكم الله وذادكم الله من فضله وعلمه

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

جزاك الله خيرا أخى الحبيب على هذا التشجيع

بعد اذن أخى الحبيب ياسر ربما هذا ما يقصده أخونا محمد ايصالي1.rar

جرب الملف المرفق التالي report.rar

أخي الحبيب ياسر العربي بارك الله فيك وجزاك الله كل خير على كل ما تقدمه من أعمال أعتبرها من الروائع بالمنتدى اسمح لي أن أرد .. وأنقد كعادتي الملف لا يقوم بفك حماية السر لمحرر الأكواد إلا إذا كان امتداد الملف الهدف xls ..فهل من طريقة تجعله يعمل على كل الامتدادات؟ هذه نقطة نقطة أخرى فيما يخص فك حماية أوراق العمل لم تعمل معي رغم أني تركت الملف فترة طويلة ليقوم بالأمر ، حتى مع تحويل الامتداد إلى Xls لم يعمل هذا الجزء أرجو الإيضاح .. يا ورد يا فواح

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

جزاك الله خيرا وربنا ما يجعلنا ممن يتعلمون فيسيؤون العمل واجعلنا ممن يتعلمون فيحسنون العمل بالتوفيق اخى ياسر

أخى و أستاذى ياسر جزاكم الله خيرا على دعمك وتشجيعك الدائم واعلم تمام العلم أن هذا ما هو إلا ثمرة بذرة غرستها أنت فىّ ألا وهى عشق الاكسل تقبل منى وافر التحية و التقدير أخى نايف مشكور على مرورك وعلى حرصك على التطبيق بالنسبة للرسالة الظاهرة لك : يظهر هذا النوع من الرسائل اذا كان فى الملف كودين يحملان نفس الاسم تأكد من أن الملف ليس فيه كود فى حدث الملف يبدأ بهذا الاسم :Private Sub Workbook_Open لان هذا الاسم يساوى Auto_Open حاولت أمس أن أرد عليك لكن النت فصل امبارح أثناء الرد لكن و رانا مشرف و مراقب نشيط هو حبيبنا فى الله ياسر خليل قام بالواجب وزيادة أخى احمد الفلاحجى مشكور على مرورك وعلى حرصك على زيادة المعرفة

شكرا أحمد الفلاحجى شكرا أخى محمد الزريعى جزاكم الله خيرا

جزاكم الله كل خير اخوانى رجب وياسر وذاكم الله من فضله وكرمه وجعلكم سابقون دائما لما فيه خير للناس تمنياتى لكم وللجميع بالتوفيق

بعد اذن الأستاذ الفاضل / ياسر العربى ولاثراء الموضوع بناءا على فكرة أخى الفاضل أحمد الفلاحجى مارأيكم بهذه الفكرة Private Sub Worksheet_SelectionChange(ByVal Target As Range) x = Application.WorksheetFunction.CountA(Range("A:A")) + 2 If Not Intersect(Target, Range("A:A")) Is Nothing Then Sheet1.Unprotect "123" ActiveSheet.ListObjects("Table1").Resize Range("$A$2:$N" & x) Range("$A$2:$N" & x).Locked = False End If Sheet1.Protect "123" End Sub TABLE WITH PROTECT 1.rar

نعم هذا الكود المطلوب وجزاك الله خير الجزاء اخي مختار ما قصرت ،، الله يجعلها في ميزان حسناتك . وأشكر استاذي القدير ياسر أبو البراء ،، من زمان وأنت واقف معانا ،، الله يعينك ،، اخي ياسر .. ------------------------------------------------------------------------------------------------------------

أخي الحبيب سعيد المفروض الحاجات الصغيرة دي منتكلمش فيها الفكرة ببساطة إني بعتمد زي ما قلت لك على إخفاء الصفوف .. ونسخ الظاهر فقط من الخلايا.. وطالما أنك تريد إخفاء العمود J يبقا الموضوع أبسط مما تتخيل في بداية الكود نظهر العمود J وننسخ ونرحل المطلوب وفي الآخر نخفيه شفت بسيطة إزاي : شالو كلب مقطقط حطوا قطة مكلبة إليك الكود بعد التعديل البسيط Sub TarhilModified() Dim Ws As Worksheet, Sh As Worksheet, LR As Long Set Ws = Sheet4: Set Sh = Sheet5 Application.ScreenUpdating = False Application.Calculation = xlManual LR = Sh.Cells(Rows.Count, "L").End(xlUp).Row + 1 With Ws .Columns("D:J").Hidden = False .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Sh.Range("L" & LR).PasteSpecial xlPasteValues .Range("I8:J" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Sh.Range("M" & LR).PasteSpecial xlPasteValues .Cells.EntireRow.Hidden = False Sh.Range("I" & LR).Resize(1, 3).Value = Array(Ws.Range("M4").Value, Ws.Range("M2").Value, Ws.Range("B4").Value) .Columns("D:H").Hidden = True: .Columns("J:J").Hidden = True Sh.Activate End With Application.CutCopyMode = False Application.Calculation = xlAutomatic Application.ScreenUpdating = True End Sub تقبل تحياتي

أخى الكريم // نؤكد عليكم الإلتزام بتعليمات المنتدى وبداخل المنتدى العديد والعديد من الملفات التى تشمل طلبك وطبعا نظرا لعدم تحديد شرط التنبيه اليكم بالمرفقات ملف بالمعادلات يعمل على ( 3 شروط ) ( 90 يوم ، 60 يوم ، 30 يوم ) يعمل بالتاريخين الهجرى والميلادى وبداخل الملف شرح لكيفية التعامل وتقبل منى وافر الاحترام والتقدير تنبيه.rar

و عليكم السلام و رحمة الله و بركاته ... أو سمي مربع النص المحدد أعلاه باسم مثل " ddd " اذا ddd = كذا افعل كذا ...

اخي ابو سيما ... كود الاستاذ جعفر يعمل عندي بدون مشاكل ...

عمود تاريخ الإرسال فارغ في معظم الصفوف ..كيف تريد التعامل مع الخلايا الفارغة في هذه الحالة؟

جرب تشيل كلمة Large الموجودة بعد كلمة Count .. وخلي كلمة Count بس (ممكن بسبب نسخة الأوفيس القديمة لديك والتي ما زلت متمسكاً بها)

لابد وأن لديك في موديول آخر إجراء فرعي بنفس الاسم ... قم بدمج الأسطر في كلا الكودين معاً لأن الإجراء خاص بالتنفيذ عند فتح المصنف

و عليكم السلام و رحمة الله و بركاته ... عاشت ايدك اخ بسام ... برنامج جميل ...

انا معرفش اكواد بصراحه ولكن فى الاعدادات هتقدر تظبطها برضه ولعل احد الاخوه ياتيك بكود مرفق صوره بالتوفيق اخى

سلام عليكم ممكن تبعث المرفق

أخي الكريم يوسف عطا جرب المعادلة بهذا الشكل علها تؤدي الغرض إن شاء الله =VALUE(LEFT(LEFT(F2,FIND(" ",F2)-1),2)) تقبل تحياتي

جواب المهندس ياسر فيه الكثير من الابداع والحكمة شكرا لك وباركك الله

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

الأخ الحبيب أحمد مرجان نعتذر عن التأخير في تقديم المساعدة (وكل تأخيرة فيها عطلة للناس بس أكيد فيها خيرة بردو) إليك الكود التالي (وعشان غرامة التأخير مرفق شرح لكل أسطر الكود عشان تقدر تعدل بما يناسبك إن شاء الله) Sub ImportDataFromClosedWBUsingVLOOKUP() 'تعريف المتغيرات Dim WBK As Workbook Dim Rng As Range Dim LastRow As Long 'إيقاف تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إيقاف خاصية رسائل التنبيه Application.DisplayAlerts = False 'ليساوي المصنف المسمى 1 والموجود في نفس مسار المصنف الحالي [WBK] تعيين قيمة للمتغير 'يقوم هذا السطر أيضاً بفتح المصنف في المسار المذكور Set WBK = Workbooks.Open(ThisWorkbook.Path & "\1.xlsx") 'تعيين قيمة للنطاق المراد جلب البيانات منه من المصنف المسمى 1 Set Rng = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row) '[Sheet1] بدء التعامل مع المصنف الحالي في ورقة العمل With ThisWorkbook.Sheets("Sheet1") 'تحديد رقم صف آخر خلية بها بيانات في العمود الأول LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'وضع معادلة دالة البحث في العمود الثاني والحصول على النتيجة من العمود الثاني في المصنف 1 With .Range("B2").Resize(LastRow - 1) .Formula = "=IFERROR(VLOOKUP(A2," & Rng.Address(, , , True) & ",2,False),"""")" .Value = .Value End With 'وضع معادلة دالة البحث في العمود الثالث والحصول على النتيجة من العمود الثالث في المصنف 1 With .Range("C2").Resize(LastRow - 1) .Formula = "=IFERROR(VLOOKUP(A2," & Rng.Address(, , , True) & ",3,False),"""")" .Value = .Value End With End With 'إغلاق المصنف المأخوذ منه البيانات بدون حفظ WBK.Close SaveChanges:=False 'إعادة تفعيل خاصية رسائل التنبيه Application.DisplayAlerts = True 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub وبكدا نكون دفعنا غرامة التأخير والحمد لله تقبل تحياتي Import Data From Closed WB Using VLOOKUP YasserKhalil.rar

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

السلام عليكم تفضل المرفق _____________.rar