(تمت الاجابة) معادلات بزر ماكرو جعلها ضمن الكود

[الشيباني1]

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

معادلات بزر ماكرو.zip

[عبدالله المجرب]

السلام عليكم

ضع هذا الكود في حدث ورقة العمل

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [F7:F1000]) Is Nothing Then

For i = 2 To 6

Target.Offset(0, i).FormulaR1C1 = Cells(4, Target.Offset(0, i).Column).FormulaR1C1

Target.Offset(0, i).Value = Target.Offset(0, i)

Next

End If

End Sub

[ابو سما]

اتمنى من الاستاذ

عبدالله المجرب

ان يقوم بعمل ورقة بة عدة ازرار وكل زر يكون مسئو عن وضع دالة واخفائة فى خلية

[الشيباني1]

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

[الشيباني1]

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

[الشيباني1]

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

[عبدالله المجرب]

السلام عليكم

اخي الكريم ما الخلل في الكود فلم افهم ما تقصده

[الشيباني1]

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

ارجو المساعده للوصول الى الغاية مع الامتنان

معادلات بزر ماكرو2.zip

[عبدالله المجرب]

اخي الفاضل

لا يتم ادراج المعادلات في الكود وانما اخذها من الخلايا الخضراء

========

في البداية جرب ان تغيير في خلية التفاصيل وسترى النتيجة

------------------------------------------------

للعلم تفعيل الكود يعتمد على التغيير في خلية التفاصيل

اما اذا اردت التفعيل يشمل التغيير في خلية الوكيل (اي بعد اختيار الوكيل يتم تفعيل الكود )

سيكون الكود هكذا

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [D7:D1000,F7:F1000]) Is Nothing Then

For i = 8 To 12

Cells(Target.Row, i).FormulaR1C1 = Cells(4, i).FormulaR1C1

Cells(Target.Row, i).Value = Cells(Target.Row, i)

Next

End If

End Sub

[الشيباني1]

استاذنا العزيز مع تقديري وشكري هل بالامكان الاستغناء عن المعادلات في الخلايا الخضراء وتضمين الكود اياها مع الامتنان

[الشيباني1]

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

[عبدالله المجرب]

تفضل

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [D7:D1000,F7:F1000]) Is Nothing Then

Cells(Target.Row, 8).FormulaR1C1 = "=IF(RC[-2]="""","""",VLOOKUP(RC[-2],prices,2,0))"

Cells(Target.Row, 9).FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-2]*RC[-1])"

Cells(Target.Row, 10).FormulaR1C1 = "=IF(COUNTIF(RC[-7]:R5C[-7],RC[-7])=1,SUMIF(C[-7],RC[-7],C[-1]),"""")"

Cells(Target.Row, 11).FormulaR1C1 = "=IF(RC[-5]="""","""",VLOOKUP(RC[-5],prices,3,0))"

Cells(Target.Row, 12).FormulaR1C1 = "=IF(RC[-6]="""","""",RC[-5]*(RC[-4]-RC[-1]))"

For i = 8 To 12

Cells(Target.Row, i).Value = Cells(Target.Row, i)

Next

End If

End Sub

[ابو تميم]

متميز وتبقى متميز أستاذنا الغالي ابو احمد

[الشيباني1]

اشكرك اخي العزيز وادامك الرحمن لنا منقذا

[عبدالله المجرب]

اخي ابو تميم شكراً للتشجيع

العفو منك اخي tofimoon4 فهذا واجبي حسب الاستطاعة