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

أخى محمد جرب الكود التالى 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

السلام عليكم ورحمة الله وبركاته كنت منذ فترة قدمت لحضراتكم موضوعا بعنوان : إغلاق آلى لملف اكسل إذا ترك بدون استخدام على الرابط التالى : 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

اتفضل اخى الفاضل دى فى الفاير وهتلاقيها فى جوجل كروم برضه ان شاء الله بالتوفيق

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

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

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

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

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

جميل ورائع أيها المعلم العبقري والأجمل الاختصار الجميل في الكود للوصول للمطلوب ..فكرة في منتهى الجمال أن تحمل القيمة True و False في متغيرات يتم استخدامها بشكل أبسط خصوصاً لو كان التعامل سيكون مع عدد أكبر من صناديق الاختيار أيوا كدا رجعنا لأيام زمااااااااااااااااان تقبل تحياتي

شكرا جزيلا للأستاذ المبدع / ياسر العربى وجزاك الله كل خير

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

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

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

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

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

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

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

أمس ما قدرت اوضع الكود بالطريقة الصحيحة ، لذا وبعد التجربة ، هذا الكود الصحيح (وقد عدّلت الكود في مشاركتي الاولى): Me.نص155 = DMax("Val([رقم العميل])", "البيانات") . والكود بظهوره الصحيح: جعفر

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

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

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

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

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

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

أخي الكريم مهند الدالة ISREF ترجع القيمة True في حالة أن ورقة العمل موجودة وتعطي القيمة False إذا لم تكن موجودة والخلية A1 هي أول مرجع في ورقة العمل المراد التأكد من وجودها أو عدم وجودها مثال لتفهم عمل الدالة : قم بإنشاء مصنف جديد وتأكد من وجود ورقة العمل Sheet1 بها وجرب الكود التالي Sub CheckSheetExistence() MsgBox Evaluate("ISREF(Sheet1!A1)") MsgBox Evaluate("ISREF(Data!A1)") End Sub النتائج ستكون للسطر الأول True لأن الورقة موجودة والسطر الثاني False لأن ورقة العمل Data غير موجودة ... بالتالي لو رجعنا للكود الأصلي سنجد أننا استخدمنا كلمة Not لعكس النتيجة ..بمعنى أن السطر في الكود الأصلي يفحص ويتأكد من عدم وجودة ورقة العمل فإذا لم (لاحظ لم Not) موجودة يتم تنفيذ باقي الأسطر ..أو بمعنى آخر : لو الورقة مش موجودة هتكون نتيجة الدالة False ووضعنا Not قبلها فيتم تحويل القيمة من False إلى True ، بالتالي طالما أن القيمة ستكون True يتم تنفيذ الأسطر التالية ...

اخى الحبيب الاستاذ الفاضل سعيد بيرم السلام عليكم ورحمة الله وبركاته أما عن الدعاء فإنني أسأل الله ربي وربكم أن يغير حالنا جميعا إلى أحسن حال وأن يجعلنا جميعا هداة مهديين لا ضالين ولا مضلين وأن يجعلنا جميعا ممن يقال لهم يوم القيامة : " ادخلوها بسلام ءامنين " آمين .أما عن اﻹجابة فقد تكفل الله بها بلحظة الدعاء " ادعوني أستجب لكم " وآية:" { أَمَّن يُجِيبُ الْمُضْطَرَّ إِذَا دَعَاهُ وَيَكْشِفُ السُّوءَ وَيَجْعَلُكُمْ خُلَفَاء الْأَرْضِ أَإِلَهٌ مَّعَ اللَّهِ قَلِيلًا مَّا تَذَكَّرُونَ } ضمن الله تعالى إجابة المضطر إذا دعاه، وأخبر بذلك عن نفسه؛ والسبب في ذلك أن الالتجاء إليه سبحانه ينشأ عن الإخلاص، وقطع القلب عما سواه. وللإخلاص عنده سبحانه موقع وذمة، وُجِدَ من مؤمن أو كافر، طائع أو فاجر؛ كما قال ‏{حتى إذا كنتم في الفلك وجرين بهم بريح طيبة وفرحوا بها جاءتها ريح عاصف وجاءهم الموج من كل مكان وظنوا أنهم أحيط بهم دعوا الله مخلصين له الدين لئن أنجيتنا من هذه لنكونن من الشاكرين‏} وقوله ‏{‏فلما نجاهم إلى البر إذا هم يشركون‏}‏ فأجابهم عند ضرورتهم ووقوع إخلاصهم، مع علمه أنهم يعودون إلى شركهم وكفرهم‏.‏ وفي الحديث‏:‏ ‏(‏ثلاث دعوات مستجابات لا شك فيهن دعوة المظلوم ودعوة المسافر ودعوة الوالد على ولده)‏ ذكره صاحب الشهاب؛ وهو حديث صحيح‏.‏ فيجيب المظلوم لموضع إخلاصه بضرورته بمقتضى كرمه، وإجابة لإخلاصه وإن كان كافرا، وكذلك إن كان فاجرا في دينه؛ ففجور الفاجر وكفر الكافر لا يعود منه نقص ولا وهن على مملكة سيده، فلا يمنعه ما قضى للمضطر من إجابته‏.‏ وفسر إجابة دعوة المظلوم بالنصرة على ظالمه بما شاء سبحانه من قهر له، أو اقتصاص منه، أو تسليط ظالم آخر عليه يقهره كما قال عز وجل :‏{وكذلك نولي بعض الظالمين بعضا‏} .‏ وفي هذا تحذير من الظلم جملة، لما فيه من سخط الله ومعصيته ومخالفة أمره؛ حيث قال على لسان نبيه في صحيح مسلم وغيره‏:‏ ‏(يا عبادي إني حرمت الظلم على نفسي وجعلته بينكم محرما فلا تظالموا‏.‏‏.‏‏.‏)‏ الحديث‏.‏ فالمظلوم مضطر، ويقرب منه المسافر؛ لأنه منقطع عن الأهل والوطن منفرد عن الصديق والحميم، لا يسكن قلبه إلى مسعد ولا معين لغربته‏.‏ فَتَصْدُق ضرورتُه إلى المولى، فيخلص إليه في اللجوء، وهو المجيب للمضطر إذا دعاه. وكذلك دعوة الوالد على ولده، لا تصدر منه مع ما يعلم من عطفه عليه وشفقته، إلا عند تكامل عجزه عنه، وصدق ضرورته؛ وإياسه عن بر ولده، مع وجود أذيته، فيسرع الحق إلى إجابته‏.‏ والسلام عليكم

شكراً لك أخي أبو خليل وسأقوم بفتح موضوع جديد وأسميه " مطلوب كود ترحيل لعدة شيتات لأوامر مختلفة "

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

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

أخي الكريم محمود ننتظر إرفاق ملفك ليطلع عليه إخوانك ممن يريدون تقديم المساعدة ... تقبل تحياتي

شوف المرفقات وان شاء الله يكون مطلوبك minimize access.zip

أخي الكريم يوسف عطا جرب المعادلة بهذا الشكل علها تؤدي الغرض إن شاء الله =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