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

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

وعليكم السلاك ورحمة الله وبركانه 🙂 ماشاءالله عليك باشمهندس ، وفي الوقت الصحيح في هذا الشهر الفضيل 🙂 جعفر

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

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

وهاي طريقة ثانية EN2: Mid([Contact Name],1,InStr([Contact Name]," ")-1) جعفر

نبارك لكم الترفيع ،، ونبارك لانفسنا لحاجتنا لخبراتكم

السلام عليكم 🙂 للعلم ، انا اضفت الزبون رقم 5 للجدول T_oldprom 🙂 لو استعملنا الاستعلام التالي ، لحصلنا على جميع الاحتمالات (استعلام مجاميع) ، لاحظ اننا ما عملنا علاقة بين الجدولين : . . والآن نضيف استعلام فرعي على الاستعلام اعلاه ، في هذا الاستعلام الفرعي ، نطلب منه ان لا يعطينا القيم الموجودة في الجدول T_oldprom 🙂 الاستعلام التالي يعطيك ارقام الهدايا الفارغة لكل زبون : . SELECT T_oldprom.CusCode, T_ConditionType.ConditionID FROM T_ConditionType, T_oldprom GROUP BY T_oldprom.CusCode, T_ConditionType.ConditionID HAVING (((T_oldprom.CusCode) Not In (SELECT T_old.CusCode FROM T_oldProm AS T_old WHERE T_old.CusCode = T_oldprom.CusCode AND T_old.ConditionType = T_ConditionType.ConditionID))) ORDER BY T_oldprom.CusCode, T_ConditionType.ConditionID; . والنتيجة : جعفر 1211.No_Match.accdb.zip

وعليكم السلام-يمكنك جعل المعادلة بهذا الشكل =IF($E4<=30,$E4*2.786,IF(AND($E4>30,$E4<=60),(30*2.786)+($E4-30)*3.536,IF($E4>60,(30*2.786)+(30*3.536)+($E4-60)*4.036))) 1حساب فاتورة الغاز.xlsx

السلام عليكم الاساتذه والخبراء والاعضاء الكرام ما المشكله في كود النسخ هذا الموجود في ي ملف (قاعدة بيانات) وكذلك ظهور القاعده بعد النسخ بهذا الشكل الذي عليه الملف المرقم برقم 11 قاعدة بيانات.rar 11.rar

السلام عليكم اذا لدي صورة ولنفرض اسمها image4 في النموذج اتعامل معها كزر كيف اكتب الكود اذا اردت ان اجعل هذا الزر غير ممكن حاولت تطبيق هذا الامر Me.image4 .Enabled = False لكن الظاهر هذا الكود لايعمل سوى مع الازرار ولاينفع مع الصور

تمام بصراحة الله ينور على حضرتك أستاذ انا كنت عامل كود كبير علشان عدد نتيجة البحث بالسجل الواحد حضرتك ما شاء الله الله اكبر سطر واحد ونتيجة رائعه الان المشكلة الكبرى 😩 كيف نحسب مجموع الكلمات لكل السجلات كل الشكر والتقدير استاذى الجليل ومعلمى القدير استاذ @Gamal.Saad جزاكم الله خيرا 🙏🌹

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

اعشق التحدي

الله يكون في العون والحمد لله على كل حال لا تتعب حالك أخي ليس بالمهم . وشكراً لك

انصحك بعدم البحث لانك ستجد ذلك الكود وتلك الطريقة ولكن اخفاء الكائنات تؤدى الى عطب قاعدة البيانات

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

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

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

من الانترنت والحمدلله شغال كويس مع سرعه السلحفاه ههههههههههه اثقل كما تحب فانا اخوك اصغير وتلميذكم

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

اعتذر لتاخرى فى الرد على حضراتكم خدمة الإنترنت سيئة جداً ولازلت انتظر الرد بعد التجربة اريد الوقوف على نقاط الضعف والقوة فى الافكار والتصميم والتكويد وتجربة ال End User اعرف انى اشق على اساتذتى واحبابي ولكن دون توجيهاتكم وارشادتكم لطلاب العلم ما تقدم منهم احد شكرا 🙏🌹 والدى الحبيب واستاذى الجليل ومعلمى القدير استاذ @jjafferr شكرا 🙏🌹 اخى الحبيب واستاذى الجليل ومعلمى القدير استاذ @أحمد الفلاحجى شكرا 🙏🌹 اخى الحبيب واستاذى الجليل ومعلمى القدير استاذ @ابوآمنة

استاذي الجليل السلام عليكم الكود لا يؤثر على النسخ القديمة لانه يجب ان يكون اسم اي ملف ومساره موجود في الجدول حتى تتم عملية الحذف وكذلك لو انشات نسخة ثم غيرت اسمها فيجب ان تغير الاسم في الجدول ايضا جرب ان تفرغ الفولدر من اي نسخة وكذلك الجدول ثم انشا نسخ جديدة ملاحظة : الفكرة مبنية على المثال الاخير الذي رفعته Desktop.rar

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

بالتوفيق اخى رضوان والله ضحكتنى اصلح الله حالك 😀 وجزاه الله خيرا معلمنا العزيز جعفر @jjafferr على حسن متابعته لنا

بارك الله فيك وجزاك الله خيرا اتفضل ان شاء الله يكون ما تريد واذا ارت اضافه حالاات اخرى افتح الاستعلام فى وضع التصميم qryNewTbl واضافه الحاله لقد تركت الاستعلامات لك لتراها وتتعلم كيف تطوعها وبما ان هذا مثال وبيانات وهميه العب فيها وخربط وشخبط شخابيط 😀 حتى تتعلم ونتعلم معك وقمت باستدعائها فقط للتشغيل بالتوفيق اخى برنامج_العقود.accdb

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

وعليكم السلام 🙂 عندك الاسم الاول والاخير في حقلين منفصلين في الاستعلام Contacts Extended : . فلماذا تريد ان تربطهم وتفكهم مرة ثانية !! استعمل حقل First Name 🙂 جعفر

شوف التقرير Directory هل هو ما تريد ؟ بالتوفيق ان شاء الله Database11.accdb

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

تفضل اخي العزيز ارجو ان يكون طلبك ملاحظة : تم حذف عبارة (قاعدة بيانات ) من النسخة الاحتياطية لاتها تسبب مشاكل في حقظ المسار بالجدول وقد يكون السبب باللغة والله العالم قاعدة بيانات11.rar

الف مبروك وبالتوفيق للاخ عبدالفتاح في بي اكسيل والاخ الرائد 77 وكل عام وانتم بخير

وعليكم السلام محاوله منى على قد حالى فالنموذج sTable1 عندك 2 كمبو هتختار السنه السابقه ثم السنه القادمه ثم تضغط ع زر اضف البيانات اذا اعطاك رساله الخطا واغلق البرنامج اعد الفتح هتلاقى جدول اسمه TBLNEW شغل استعلام التحديث ثم استعلام الالحاق سيتم اضافه البيانات الجديده للجدول TABLE2 لا اعلم ان كانت رساله الخطأ هذه تحدث بسبب النسخه ام لا جارى تنزيل اوفيس 2019 والتجربه بعدها فى انتظار تجربتك وابلاغى هل ظهرت اى رسائل خطأ ام لا لحين تنزيل الاوفيس الجديد وان شاء الله الاخوه واساتذتنا يساعدون بما لديهم تقبل تحياتى وبالتوفيق ان شاء الله برنامج العقود.rar

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

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

جزاك الله خيرا معلمنا العزيز جعفر @jjafferr جعله الله فى موازين حسناتك ان شاء الله وبارك الله لك فى كل ما تحب

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

اتفضل اليك ما طلبت القي نظرتا الى صورة واليك الملف بعد اضافة تقرير hatem (1).accdb

السلام عليكم ايضا اذا اردنا التخيير بين فتح النموذج لعرض البيانات والتعديل عليها وبين فتحه لإدخال البيانات Private Sub Form_Open(Cancel As Integer) If MsgBox("Yes = لإدخال بيانات جديدة" & vbCrLf & _ "NO = لعرض البيانات والتعديل", _ vbQuestion + vbYesNo, _ "عرض وإدخال") = vbYes Then Me.DataEntry = True Else Me.DataEntry = False End If End Sub

الف مبروك حفظكم الله

الف الف مبروك للاستادين عبد الفتاح و الرائد رمضان كريم

بالعكس ، الفكرة جدا جميلة ، وتُظهر براعة المبرمج وفهمه في تسهيل امور المستخدم 🙂 انا شفت مجموعة من البرامج ، لما يفتح البرنامج ، نرى نموذج فارغ (شاشة بيضاء) ، ولا يوجد اي شيء ممكن ان يعمله المستخدم سوى الخروج من النموذج !! بينما الفكرة هنا ، ان نغير اعدادات النموذج : لجعل النموذج يقبل ادخال البيانات me.DataEntry = True me.allowedits = true me.allowadditions = true . هكذا فيتحول النموذج الى نموذج ادخال بيانات 🙂 جعفر

الف مبروك وبالتوفيق للاخ عبدالفتاح في بي اكسيل والاخ الرائد 77 وكل عام وانتم بخير ورمضان كريم

الف مبروك و الي الأمام دائما باذن الله

معادلا ت ممتازة لكن في هذه الحالة لا بد من ادراج معادلة مستقلة لكل عامود من العامود (R) الى العامود (AC) بينما في اجابتي معادلة في الخلية (R6) واحدة تكفي مع سحبها يسارا 12 عامود و نزولاً 6 صفوف (بدون عامود مساعد)

كود آخر لنفس الموضوع وللعلامه عبد الله باقشير وهذا رابطه LastRow_1 = Cells(Rows.Count, "C").End(xlUp).Row + 12 Range("AY13:AZ" & LastRow_1).ClearContents Dim MyBoolean As Boolean Sub اضافة_حذف() On Error Resume Next Dim XX As Shape Set XX = ActiveSheet.Shapes("الدائرة") With XX.TextFrame.Characters If .Text = "اضافة الدوائر" Then Circles1 .Text = "حذف الدوائر" Else Kh_DeletShape .Text = "اضافة الدوائر" End If End With On Error GoTo 0 End Sub Sub Circles1() On Error Resume Next Dim MyRng_All As Range, c As Range Dim V As Shape, S As String Dim K As Integer, x As Integer, d As Long, N As Integer, y As Integer Dim عمود_رقم_الجلوس As Integer, صف_مواد_دور_ثاني As Integer, صف_الدرجات As Integer Dim عمود_حالة_الطالب As Integer, عمود_المواد As Integer '================================================ عمود_رقم_الجلوس = 2 صف_الدرجات = 12 صف_مواد_دور_ثاني = 8 عمود_حالة_الطالب = 51 عمود_المواد = 52 y = Sheets("بيانات المدرسة").Range("B10").Value + 12 Set MyRng_All = Range("p13", Cells(y, 51)) ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ x = ActiveWindow.Zoom Application.ScreenUpdating = False LastRow_1 = Cells(Rows.Count, "C").End(xlUp).Row + 12 Range("AY13:AZ" & LastRow_1).ClearContents ActiveWindow.Zoom = 100 For Each c In MyRng_All K = c.Column If Cells(c.Row, عمود_رقم_الجلوس) = 0 Then GoTo 3 If Cells(صف_مواد_دور_ثاني, c.Column) <> "م" Then If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _ And (c.Value < Cells(صف_الدرجات, c.Column) Or c.Value = "غ" Or c.Value = "غـ") Then If MyBoolean Then GoTo 1 Kh_AddShape c, V d = d + 1 End If 1 Else If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _ And (c.Value < Cells(صف_الدرجات, c.Column) Or Cells(c.Row, c.Column - 1) < Cells(صف_الدرجات, c.Column - 1) Or Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ") Then If Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ" Then N = N + 1 '================================================ ' ترحيل مواد دورثاني ان وجدت If Cells(c.Row, عمود_المواد) = "" Then S = "" Else S = " - " Cells(c.Row, عمود_المواد) = Cells(c.Row, عمود_المواد) & S & Cells(صف_مواد_دور_ثاني - 1, c.Column) '================================================ If MyBoolean Then GoTo 2 Kh_AddShape c, V d = d + 1 End If End If '================================================ ' ترحيل حالة الطالب 2 If K = MyRng_All.Columns.Count + MyRng_All.Column - 1 Then If N = 4 Then Cells(c.Row, عمود_حالة_الطالب) = "غائب": Cells(c.Row, عمود_المواد) = "جميع المواد" _ Else If Cells(c.Row, عمود_المواد) = "" Then Cells(c.Row, عمود_حالة_الطالب) = "ناجح ومنقول للصف الثالث" Else Cells(c.Row, عمود_حالة_الطالب) = "له دور ثاني في" N = 0 End If '================================================ 3 Next ActiveWindow.Zoom = x Application.ScreenUpdating = True If MyBoolean Then GoTo 4 MsgBox "تم إضافة " & d & " دائرة بنجاح" & Chr(10) & Chr(10) & "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله" On Error GoTo 0 4 End Sub Sub Kh_AddShape(MyCell As Range, Kh_shp As Shape) Set Kh_shp = ActiveSheet.Shapes.AddShape(msoShapeOval, MyCell.Left, MyCell.Top, MyCell.Width, MyCell.Height) With Kh_shp .Fill.Visible = msoFalse .Line.ForeColor.SchemeColor = 10 .Line.Weight = 2.25 End With End Sub Sub Kh_DeletShape() Dim myshape As Shape, d As Long For Each myshape In ActiveSheet.Shapes If myshape.Type = 1 Then myshape.Delete: d = d + 1 Next myshape MsgBox "تم حذف " & d & " دائرة بنجاح", vbMsgBoxRight, "الحمدلله" End Sub Sub تحديث() MyBoolean = True Circles1 MyBoolean = False MsgBox "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله" End Sub

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

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

السلام عليكم ورحمة الله أخي الكريم عيد مصطفى قمت بتبسيط المعادلات حسب ما فهمته من المطلوب لأنه تم إلغاء فترة التسديد بين تاريخين وأصبح التسديد لكل الرصيد في تاريخ معين... واستعملت دالة ABS لجعل كل المبالغ المسددة بقيم موجبة بدلا من ضرب الناتج في العدد -1.... أرجو أن يكون هذا المطلوب أو بعضا منها وإذا كان غير ذلك فأرجو الشرح أكثر حتى نكون على دراية بما ستكون عليه المعادلات لتتناسب مع المطلوب... أخوك بن علية Accrued Exp. Settlement.rar

السلام عليكم ورحمة الله أخي الحبيب دغيدي، الدالة ADRESS تعطي مرجعا (عنوانا) لخلية حسب الوسائط المستعملة مع الدالة وصيغتها كما يلي: =ADRESS(Row_Num, Column_Num, [Type], [a1], [Sheet_Name]) شرح الوسائط: * Row_Num : رقم السطر (ضروري) * Column_Num : رقم العمود (ضروري) * Type : (غير ضروري) نوع المرجع وهي رقم من 1 إلى 4 حسب ما يلي: 1 أو فراغ : مرجع مطلق مثل 1$A$ 2 : مرجع مطلق للسطر مثل A$1 3 : مرجع مطلق للعمود مثل A1 $ 4 : مرجع نسبي مثل A1 * a1 : قيمة منطقية (غير ضروري)، TRUE أو فارغة: للترميز لعمود الخلية بحرف وسطرها برقم مثل A1 و FALSE : للترميز لعمود وسطر برقم مثل L1C1 (المرجع المطلق في هذا الترميز هو رقم دون قوسين والمرجع النسبي هو رقم بين قوسين)... * Sheet_Name : (غير ضروري) اسم الشيت بين علامتي التنصيص "" إذا أردنا أن يُذكر اسم الشيت في المرجع مثل Sheet1!A1 أو غيرها أمثلة : =ADRESS(2;4) تعطي المرجع : D$D$2$ =ADRESS(2;1;3) تعطي المرجع : A2$A2 =ADRESS(2;1;3;FALSE) تعطي المرجع : L(2)C1 =ADRESS(5;3;;;"SHEET1") تعطي المرجع : SHEET1!$C$5 ويمكن إعطاء أمثلة أخرى حسب الشرح بالأعلى... أرجو أني وُفقت في إعطاء شرح بسيط للدالة ADRESS ولزيادة في الفهم يمكن الاستعانة بما يقدمه الإكسيل في Help الذي يخص هذه الدالة... ملاحظة: في عبارة الدالة ينبغي التأكد من الفاصلة المنقوطة أو الفاصلة بين وسائط هذه الدالة حسب نسخة الأوفيس... أخوك بن علية

الاستاذ الحبيب دغيدي هذا تعديل الكود من قبلي لطلبك الاخير بداية صف الجمع حسب الرقم المدرج في "L2" Sub Su_Alidroos() On Error Resume Next A = [J2]: AA = [K2] B = [J3]: BB = [K3] Ct = [J4]: CC = [K4] D = [J5]: DD = [K5] '============================================= 'خلية تحدد فيها بداية رقم صف الجمع المراد RR = Val([L2]) '============================================= For C = 1 To 8 Cells(RR, C) = S_Ali(Range(Cells(A, C), Cells(AA, C))) Cells(RR + 1, C) = S_Ali(Range(Cells(B, C), Cells(BB, C))) Cells(RR + 2, C) = S_Ali(Range(Cells(Ct, C), Cells(CC, C))) Cells(RR + 3, C) = S_Ali(Range(Cells(D, C), Cells(DD, C))) Next End Sub Function S_Ali(m_r As Range) Dim C_Ali As Range, C_D As Double For Each C_Ali In m_r If IsNumeric(C_Ali) Then C_D = C_D + C_Ali.Value End If Next S_Ali = C_D End Function وبعد اذن الاستاذ القدير خوبر خير وهذا كود العلامه خوبر خير Sub kh_Sum() Dim RngTest As Range Dim R As Integer, C As Integer Dim RR1 As Integer, RR2 As Integer '============================================= 'خلية تحدد فيها بداية رقم صف الجمع المراد Kh_Add = [L2] '============================================= Set RngTest = Range("MySumRow") With Range("A4:H61") For R = 1 To RngTest.Rows.Count RR1 = RngTest.Cells(R, 1).Value RR2 = RngTest.Cells(R, 2).Value For C = 1 To .Columns.Count Range("A" & Kh_Add).Cells(R, C) = WorksheetFunction.Sum(Range(.Cells(RR1, C), .Cells(RR2, C))) Next Next End With Set RngTest = Nothing End Sub الجمع بمعلومية خلايا_1.rar