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

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

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

نرحب بالأخ سليم حاصبيا فى فريق الموقع ونسأل الله أن يعينك على مهام الاشراف أهلا وسهلا

الاخوة الاعزاء في المنتدى الموقر محمد طاهر ياسر خليل أبو البراء زيزو العجوز ابو يحيى1 احمد بن ابراهيم عمر الحسيني جلال الجمال_ابو ادهم ابو عبدالبارى حسين22 قلم-الاكسل(عبدالعزيز) احمد21 الخ.... (و كل من يظهره التحقيق) الف شكر على التهنئة وان شاء الله سوية الى أبعد من الواجب

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

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة كود نقل الاسماء بدون تكرار تم ارفاق كود الحل من الفاضل أ / رحمة الله _ عماد الحسامى _ طارق محمود _ يحيى حسين و لا تنسونا من صالح الدعاء تحياتى اظهار الاسماء بدون تكرار11 (hossai).rar اظهار الاسماء بدون تكرار_hossai.rar اظهار الاسماء بدون تكرار2 (tarek).rar اظهار الاسماء بدون تكرار بعد الكتابة مباشرة - الاستاذ يحيى حسين (1).rar

أين العريس ؟ غاب عنا في فرحة عرسه .. أهذا يجوز؟ إلى الأمام أخي الغالي سليم

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

فقط اريد أن ادلي بملاحظتين مهمتين 1 - كل ما كان الملف يحتوي على شرح مفصل للمطلوب و نموذ واضح للحل المراد الوصول اليه كلما اسرع الاخوة في الرد بدون تردد 2 - كلنا نتعلم و ربما المجيب عن السؤال يستفيد اكثر من السائل عنه لانه في هذه الحالة قد ارتقى بخطوة للامام و تعلم شيئا ربما لم يسبق له ان خاض فيه هل يستطيع أحدنا ان يختبر نفسه بطرح اسئلة على نفسه ثم يجيب عنها ؟ قطعا لا و لذلك دوما نتشوق الى الاسئلة التي تكون معالمها واضحة لنجيب و نفيد و نستفيد

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

جزاكم الله خيرا أخي ياسر و اخي جلال المرفق به إمكانية البحث بأكثر من معيار على السريع و ربما يحتوي على بعض الأخطاء 3333.rar

مرحبا عملت على الملف و نسيت ان ارفه الى المنتدى 2222.rar

انا حشارك فقط بوجود الخطأ في اول مشاركة وفي السطر rs.FindFirst "[UserName]= ' " & Me.txtUserName & " ' And [Department]= ' " & Me.Me.cboDepartment & " ' " تلاحظ تكرار me اخ بو عبدالله

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

مشاركة مع اخوتي واحبتي الكرام تفضل .. وغير ما يلزم .. حسب المسميات عندك Dim rs As Recordset Private Sub cmdOK_Click() Set db = CurrentDb Set rs = db.OpenRecordset("tblUsers", dbOpenDynaset) rs.FindFirst "UserName = '" & UserName & "' and password ='" & Password & "'" If rs.NoMatch Then MsgBox "هذا المستخدم غير مسجل" Exit Sub Else DoCmd.OpenForm "frm_main" DoCmd.Close acForm, Me.Name End If End Sub

Dim rs As Recordset Dim Criteria As String Set rs = CurrentDb.OpenRecordset("tblUser", dbOpenSnapshot, dbReadOnly) Criteria = "[UserName]='" & [txtUserName] & "' And [Department]='" & [cboDepartment] & "'" rs.FindFirst Criteria If rs.NoMatch = True Then MsgBox "يرجى الـتأكد من إسم المستخدم", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "رسالة تنبيه" Me.txtUserName.SetFocus Exit Sub End If If rs!Password <> Me.txtPassword Then MsgBox "يرجى الـتأكد من كلمة السر", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "رسالة تنبيه" Me.txtPassword.SetFocus Exit Sub End If هل تسمحون لى بالمشاركة معكم شرطين فى دالة البحث rs.FindFirst

جرب هذا الشيء salim.rar

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

كيف يمكن يمكن القيام بهذا التنسيق الشرطي zebra-lines with Cond_Format.rar

تحياتى و ايام مباركه مرفق كود مرن و هام يقوم باستدعاء الفورم بدبل كليك يمكن الاستفاده منه فى اى برنامج او ملف ( و هو منقول من ضمن مشاركات المنتدى ) فمثلا لو عندك فورم بحث و اضافة مطلوب استدعائه فى نطاق معين لادخال و تكويد بيان معين بدلا من استخدام القائمه المنسدله فضع هذا الكود البسيط فى حدث الصفحه المطلوبه Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("a1 : a1", "b2 : b2230")) Is Nothing Then Cancel = True UserForm1.Show End If End Sub فعند الضغط / الكابس دبل كليك على الخانه A1 او النطاق B2:B2230 يتم استدعاء فورم او ليست اسمه userform1 تحياتى و لا تنسونا من صالح الدعاء G_Double click.rar

السلام عليكم ورحمة الله وبركاته كل الشكر والتقدير لهذا الصرح العظيم المنارة التي يهتدى بها الملف المرفق هو عبارةيومية صندوق مع كشف حساب.rarيومية صندوق مع كشف حساب.rar عن يومية صندوق(عملة) (قبض . دفع) يتم ادخال البيانات بالفورم . بالاضافة الى كشف حساب و رصيد الصندوق النهائي وقد عملت فيه عدة ميزات: 1- يتم ادخال البيانات بالفورم دون الحاجة لاستخدام الماوس عند اختيار الاسم (لأنني من الاشخاص الذين لايحبون استخدام الماوس أثناء العمل) 2-يظهر اليوم والتاريخ ضمن الفورم (لاننا في يومية صندوق . يعني يومية اليوم الحالي) وطبعا يمكن التعديل على التاريخ 3- بعد الانتهاء من التاريخ وضغط انتر يظهر فورم بحث عن اسم الحساب 4- تكست بوكس (مدين - دائن) يقبل الارقام فقط 5- كشف الحساب يتم باختيار الاسم من قائمة منسدلة او بالنقر دبل كليك على خانة الاسم لكن يوجد بعض التعديلات شرحتها في الملف الرجاء المساعدة من الاخوة الاكارم يومية صندوق مع كشف حساب.rar

الحمدلله .. وشكرا على دعواتك الطيبة .. وجعل الله لك نصيبا منها

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

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

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

الاخ سليم حاصبيا الف مبرك اخي سليم حاصبيا نعرف انك علي مستوي المسؤلية الي الامام دائما ونراك بإذن الله في المستقبل مراقب عام همام تحياتي لك

إضف فقط اشارة تنصيص لكل من Password و Text Private Sub ShowPassword_AfterUpdate() If Me.ShowPassword.Value = False Then Me.txtPassword.InputMask = "Password" Else Me.txtPassword.InputMask = "Text" End If End Sub

أخي الكريم أحمد جربت الملف المرفق وكلا الكودين يعملان بشكل صحيح وتتم الحماية لجميع الأوراق بلا استثناء وعند فك الحماية يتم فك الحماية لجميع أوراق العمل بلا استثناء .. حاول توضح المشكلة بالصور ، وهل يحدث معك خطأ من نوع معين كرسالة خطأ أو ما شابه؟ قرأت المشاركة مرة أخرى ولربما يكون هذا ما تقصده Sub protectclose() Dim a As Worksheet For Each a In Worksheets If a.Name <> "ورقة1" And a.Name <> "ورقة2" And a.Name <> "ورقة3" Then If a.ProtectScenarios = False Then a.Protect "1111" End If End If Next a End Sub هذا كود الحماية لجميع الأوراق ما عدا أوراق العمل المحددة في سطر في الكود وهي ورقة1 ، ورقة2 ، ورقة3

الف مبروك لأستاذنا سليم حاصبيا ترقية باستحقاق وجدارة

الحمد لله أن تم المطلوب على خير .. تذكرة ايه اللي بتتكلم عليها؟ تذكرة قطار أم تذكرة سينما أم تذكرة طيران أم تذكرة للحج ....؟

ياسر خليل أبو البراء اخى الفاضل جزاك الله خيرا

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

تمام اخى ياسر ياراجل دا انا هموت من الجوع ومش عاوز اقوم من قدام الجهاز غير لما تسامحنى هروح اتغدا بقى واجى

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

السلام عليكم اخي احمد بعد إذن الأخ المحترم ياسر جرب هذا الكود ربما يفي بالغرض Sub sCopy() Application.ScreenUpdating = False Dim sh As Worksheet, MySheet As Worksheet, Ar Set sh = Sheets("اليومية") Ar = Array("يناير", "فبراير", "مارس", "ابريل", "مايو", "يونيو", "يوليو", "اغسطس", "سبتمبر", "اكتوبر", "نوفمبر", "ديسمبر") For i = 6 To sh.Range("B" & Rows.Count).End(xlUp).Row For x = 0 To 11 Set MySheet = Sheets(Ar(x)) If Format(sh.Cells(i, 2), "mmmm") = MySheet.Name Then LR = MySheet.Range("A" & Rows.Count).End(xlUp).Row + 1 sh.Range("A" & i).Resize(, 16).Copy MySheet.Range("A" & LR).PasteSpecial xlPasteValues End If Next Next Application.ScreenUpdating = True End Sub

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

أخي الكريم أحمد هوناً عليك ورفقاً بنا .. والصبر مطلوب .. والكود بيعمل Done ما شاء الله (خبير أكواد عشان تعرف الكود بيعمل ايه من غير ما تجربه بشكل صحيح .. دي سخرية لا أقبل بها !! ) هل قمت بنسخ الكود إلى موديول جديد ؟ أنا قبل إرفاق أي كود أقوم بتجربته والتأكد من صحة المخرجات اذكر لنا ما المشكلة التي لديك؟ أو ارفق الملف وبه الكود للتأكد مرة أخرى .. ويا سيدي حقك عليا إذا كنت اتعقدت من الموضوع .. بس لاحظ إن إنت اللي واخد الموضوع وشايف صعب وعشان كدا معقد بالنسبة لك حاول تشوف الموضوعات الأخرى وشوف استجابة الأعضاء .. هتلاقي موضوعك لم يستجيب فيه أحد وأردت تقديم المساعدة قدر الإمكان .. وإذا كنت لا تريد مساعدة مني فهذا يرجع إليك ولكني حينما أقدم مساعدة لا ألتفت لشخص بعينه إنما يهمني مصلحة الجميع قبل مصلحة الفرد ، لأنه قد يكون هناك من لديه نفس المشكلة ويريد حلها ... أرجو تفهم الأمر وأقدم اعتذاري الشديد

أبو حنــــين اخى الفاضل ما شاء الله عليك

عمل رائع أبو حنين .. بصراحة ممتاز ممتاز ممتاز ( 3 ممتاز = 1 روعة) يا ريت بقا تعمل لنا على نفس الملف إمكانية الاختيار من أكثر من عنصر للبحث ..مثال : نختار اسم الحساب الرئيسي العمليات ، ثم نحتفظ بالنتائج ونختار اسم العميل ونكتب اسم معين أقصد أن يكون مرن في البحث بأكثر من معيار تقبل وافر تقديري واحترامي

العفو استاذ عبدالله وهذه فكرة اخرى sumdebit2: DSum("[debit]","entry","left([code]," & Len([code]) & ")=" & [code]) بالتوفيق

Private Sub TextBox1_Change() 'اخر الكريم تقبل تحياتى وهذا شرح بسيط بالعامية المصرية والبلدى كدة بدون التطرق للشرح العملى 'للمتغيرات والمعادلات لان هذا يطول شرحة وستجد ما طلبت اذا بحثت بالمنتدى الرائع اوفيسنا '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' السطر القادم لتفادى اى خطأ فى الكود ومنع اظهار رسالة ال debug للمستخدم On Error Resume Next ' بقوله افرغ محتويات الليست بوكس علشان لما تفتح الليست المرة القادمة متلاقيش البيانات المبحوث عنها المرة اللى فاتت موجودة ListBox1.Clear ' متغيرات لاسم الصفحة والصفوف Dim ws As Worksheet Set ws = Sheets("data") Dim i As Long Dim v As Integer 'بقوله هنا لو التكست بوكس اللى ببحث فيه مش فاضى نفذ اللى جاى If Me.TextBox1.Text <> "" Then '================================================ 'هنا بقوله لو اتكتب فى التكست بوكس من غير ما تعلم على نوع البحث من التلات خيارات يطلعلك رسالة تنبيه انك لابد ان تختار اولا 'ويوقف تنفيذ باقى الكود If Me.esm.Value = False And Me.ra2eesy.Value = False And far3y.Value = False Then MsgBox "رجاء اختر نوع البحث اولا" Me.TextBox1 = "" Exit Sub End If '============================================== 'هنا بقى متغير اسمه lr وده بيحددلى اخر صف فيه بيانات فى العمود lr = ws.Range("b" & Rows.Count).End(xlUp).Row ' بقوله من الصف الخامس لغاية اخر صف فيه بيانات نفذ اللى جاى ' وديه اسمها حلقة تكرارية For i = 5 To lr ' هنا متغيرات لتحديد الصفوف المبحوث بها سواء بالاسم او الفرعى او الرئيسي comp = ws.Cells(i, "b") 'اسم comp2 = ws.Cells(i, "c") 'فرعى comp3 = ws.Cells(i, "d") 'رئيسي If ws.Cells(i, 1) <> "" Then '============================================================ 'لو البحث بالاسم هو اللى متحدد كومب هتبقي زى ماهى وهيبقى عمود البحث هو b If Me.esm.Value = True Then comp = comp End If 'هنا لو الفرعى هو المتحدد كومب هتساوى كومب 2 اللى هو عمود البحث بالفرعى If Me.far3y.Value = True Then comp = comp2 End If 'كذلك الامر هنا If Me.ra2eesy.Value = True Then comp = comp3 End If '============================================================ ' اللى فات هنستخدمه هنا فى داله البحث باى حرف فى الكلمة من غير شرح كتير علشان يطول الشرح ' اللى يشغلك فيها كومب اللى احنا معرفينه فوق وهو نطاق البحث 'واللى انت هتبحث فيه وهو التكست بوكس 'وهيقارن اللى كتبته فى التكست بوكس بالبيانات اللى فى نطاق البحث If InStr(1, comp, Me.TextBox1.Text, vbTextCompare) Then ' هنا بقوله لما تلاقى بيانات البحث ضيفها فى الليست بوكس ListBox1.AddItem 'v ده متغير زى i وده للصفوف 'الليست بتبتدى من الشمال لليمين وهما اربع صفوف (v,0) معناها الصف v اللى هيتكرر لو فى اكتر من نتيجة للبحث 'و zero معناها العمود الاول فى الليست من الشمال وهكذا ' وهنا بقوله ضيف نتائج البحث فى العمود 1 والصف i فى العمود التالت والصف v فى الليست بزكس وهكذا Me.ListBox1.List(v, 3) = ws.Cells(i, 1).Value 'مسلسل Me.ListBox1.List(v, 2) = ws.Cells(i, 2).Value 'اسم Me.ListBox1.List(v, 1) = ws.Cells(i, 3).Value 'حساب فرعى Me.ListBox1.List(v, 0) = ws.Cells(i, 4).Value 'رئيسي 'وديه علشان لو اكتر من نتيجة للبحث تتكرر ولو مكتبتهاش هيجيبلك نتيجة واحدة فقط v = v + 1 ' اقفل معادلات if End If End If ' اقفل الحلقة التكرارية for i = 5 to lr Next i 'ولو الليست بوس فاضية مفيهاش صفوف او عدد صفوفها 0 امسحها علشان نتايج البحث السابقة متفضلش موجودة If Me.ListBox1.ListCount = 0 Then Me.ListBox1.Clear End If 'كل اللى فات هيحصل لو التكست بوكش مش فاضى طيب لو فاضي امسح الليست بوكس Else Me.ListBox1.Clear 'اقفل قاعدة if End If End Sub

السلام عليكم ورحمة الله تفضل هذا الكود Sub Summing1() f = 0 s = 0 For i = 2 To Sheets.Count For R = 15 To Cells(Rows.Count, "I").End(xlUp).Row Sheets(i).Name = i - 1 f = f + Sheets(i).Cells(R - 11, "I") Cells(R, "J") = f s = s + Sheets(i).Cells(R - 11, "J") Cells(R, "K") = s Next Next End Sub

السلام عليكم جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim sh As Worksheet If Target.Column = 9 And Target.Row > 14 Then Application.ScreenUpdating = False For Each sh In Sheets If IsNumeric(sh.Name) = True Then LR = sh.Cells(Rows.Count, "G").End(xlUp).Row ActiveCell.Offset(-1, 1).Value = ActiveCell.Offset(-1, 1).Value + WorksheetFunction.SumIf( _ sh.Range("G4:G" & LR), CStr(ActiveCell.Offset(-1).Value), sh.Range("I4:I" & LR)) ActiveCell.Offset(-1, 2).Value = ActiveCell.Offset(-1, 2).Value + WorksheetFunction.SumIf( _ sh.Range("G4:G" & LR), CStr(ActiveCell.Offset(-1).Value), sh.Range("J4:J" & LR)) ActiveCell.Offset(-1, 3).Value = ActiveCell.Offset(-1, 1).Value + ActiveCell.Offset(-1, 2).Value End If Next Application.ScreenUpdating = True End If End Sub

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

الجزء الثاني Omar_2.part2.rar

كل عام وانت وجميع الامة الاسلامية بخير

معلم الله عليك يا كبيرنا بس انت معودنا على انك بتشرح بالصور انت معلم والكل منك يتعلم

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

انسخ هذه المعادلة و اسحب نزولاً =IF(INDIRECT("C"&ROWS($A$1:A1)*2)="","",INDIRECT("C"&ROWS($A$1:A1)*2))

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