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

[محمد عبدالرحمن 1]

السلام عليكم

 

بحثت في المنتدى الشامخ ووجدت هذا العمل لاحد الاخوه

ولكن يوجد مشكلة صغبرة 

كيف اجعل اضافت الصف تكون في الجدول الاول في نطاق محدد وليس تحت اخر صف 

بنتظار المساعدة 
بارك الله فيكم 

ادراج صفوف لاسفل بنفس التنسيق والمعادلات دون التأثير على عملية الجمع 2017.rar

تم تعديل يناير 12, 2017 بواسطه محمد عبدالرحمن 1

[محمد عبدالرحمن 1]

امـــــــــــــــــــــــــــــــــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[محمد عبدالرحمن 1]

امـــــــــــــــــــــــــــــــــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[محمد عبدالرحمن 1]

امـــــــــــــــــــــــــــــــــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[محمد عبدالرحمن 1]

امـــــــــــــــــــــــــــــــــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[محمد عبدالرحمن 1]

ياكرام ساعدوني بارك الله فيكم امـــــــــــ بنتظاركم ــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[محمد عبدالرحمن 1]

 

.

 

ياكرام ساعدوني بارك الله فيكم

امـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــل

المساعــــــــــــــــــــ بنتظاركم ــــــــــــــــــــدة

 

 

.

[أبوعيد]

السلام عليكم

توصلت للحل والحمدلله ولكن ام استطع تحميل الملف لوجود مشكلة

ولا زلت أحاول رفع الملف

[محمد عبدالرحمن 1]

 

.

 

استاذ ابوعيد 

يعطيك العافيه ومشكور مقدما 

 

جرب تغير المتصفح واظغط الملف 

والا اكتب الكود هنا 

 

 

 

.

[أبوعيد]

الكود هو

Sub Kh_Insert_Rows()
Dim r
r = ActiveCell.Row

    Range("A" & r).Resize(1, 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

End Sub

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

ثم بعد ذالك حدد أي خلية وشغل الكود سيتم إضافة صفوف مكان الخلية المحددة

إذا لم تنجح العملية معاك راسلني على الأي ميل الظاهر تحت اسمي حتى ارسل لك الملف كاملا

تحياتي

[محمد عبدالرحمن 1]

 

.

 

استاذ ابوعيد 

يعطيك العافيه ومشكور مقدما 

 

جربت  الكود 

 

للاسف يضيف الصف بدون المعادلات والاكواد 

يعني اضافة فقط

 

 

 

.

[ابراهيم الحداد]

السلام عليكم ورحمة الله

ادرج هذا الكود بدلا من الكود الموجود

Sub CmdInsertRw()
    Dim lRow As Long
    Dim lRsp As Long
    On Error Resume Next
    lRow = Application.InputBox(Prompt:="ادخل رقم الصف المراد ادخال الصف بعده", _
    Title:="ادراج عدد محدد من صفوف ", Default:=1, Type:=1)
    lRsp = Application.InputBox(Prompt:=" ادخل عدد الصفوف " & Chr(10) & "عدد الصفوف الافتراضية " & 1, _
    Title:="ادراج عدد محدد من صفوف ", Default:=1, Type:=1)
 If lRsp = False Then Exit Sub
    Rows(lRow).Select
    Selection.Copy
    Rows(lRsp).Selec
    Selection.Insert Shift:=xlDown
    Rows(lRow + 1).PasteSpecial xlPasteFormulasAndNumberFormats
        Application.CutCopyMode = False
End Sub

وغير المعادلة الموجودة فى ( A3 )  الى  (  A3 - 1 = ) 

 

[محمد عبدالرحمن 1]

 

.

 

استاذ زيزو العجوز 

يعطيك العافيه ومشكور مقدما 

 

جربت  الكود اصبح يضيفصف واحد فقط مع المعادلات والاكواد 

يعني ليسى حسب الاختيار

 

وغيرت المعادلة الى   الى  (  A3 - 1 = ) 

ولكن لا يقبل

ارجو منك التكرم بوضعها في الملف وارفقه

ولك الشكر

 

.

[أبوعيد]

تم تطوير الكود ليناسب طلبك

Sub Kh_Insert_Rows()
Dim r, s, x, c
r = ActiveCell.Row
s = InputBox("ÃÏÎá ÚÏÏ ÇáÕÝæÝ ÇáãÑÇÏ ÃÖÇÝÊåÇ", "ÅÖÇÝÉ ÇáÕÝæÝ", 1)
If r < 4 Then Exit Sub
Application.ScreenUpdating = False
For x = 1 To s
    Range("A" & r).Resize(1, 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next

Range("A" & r - 1).AutoFill Destination:=Range("A" & r - 1).Resize(s + 1, 1), Type:=xlFillDefault
Range("D" & r - 1).Resize(1, 4).AutoFill Destination:=Range("D" & r - 1).Resize(s + 1, 4), Type:=xlFillDefault
c = Range("A3").End(xlDown).Row
Range("A3").FormulaR1C1 = "=MAX(R2C:R[-1]C)+1"
    Range("A3").AutoFill Destination:=Range("A3:A" & c)

Range("A3:A" & c) = Range("A3:A" & c).Value
Application.ScreenUpdating = True
End Sub

إضافة الصفوف سيكون من بداية الصف الرابع وما بعده

يعني لن تستطيع إضافة صقوق في الصف الثالث

تحياتي

إضافة صفوف.rar

[محمد عبدالرحمن 1]

استاذ ابوعيد

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

وانت يبدو لي اضفت المعادلة نفسها الجمع بالاكواد

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

وارفقت ملف يوضح الفكرة بشكل افضل وتفصيلي

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

ولكم  الشكر

 

إضافة صفو ف بالاكواد والتنسيق.rar

[محمد عبدالرحمن 1]

ياكرام ساعدوني بارك الله فيكم امـــــــــــ بنتظاركم ــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[أبوعيد]

جرب هذا

 

إضافة صفو ف بالاكواد والتنسيق1.rar

[محمد عبدالرحمن 1]

استاذ ابوعيد

والله انت مبدع

يعطيك العافيه 

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

مرفق صوره 

وكذالك المعادلة في عامود G لم تندرج في الاضافة 

 

واطلب منك لوتكرت 

كتابة توضيح وشرح تحت كل كود بالعربي لكي افهم 

واستطيع التعديل في المستقبل

يعني هو يخذ كبي نسخ من اي سطر يكررة

المدى التنسيق عمل كل سطر بالكود

 

Private Const ContColumn As Integer = 7

Sub Kh_Insert_Rows()
Dim r, s, x, c, d
'r = ActiveCell.Row
s = InputBox("أدخل عدد الصفوف المراد أضافتها", "إضافة الصفوف", 1)
'If r < 7 Then Exit Sub
Application.ScreenUpdating = False
r = Range("A6").End(xlDown).Row + 1
For x = 1 To s
    Range("A" & r).Resize(1, 18).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A" & r) = 1
Next
c = Range("A6").End(xlDown).Row
Range("A" & r - 1).AutoFill Destination:=Range("A" & r - 1).Resize(s + 1, 1), Type:=xlFillDefault
Range("C" & r - 1).Resize(1, 2).AutoFill Destination:=Range("C" & r - 1).Resize(s + 1, 2), Type:=xlFillDefault
Range("R" & r - 1).Resize(1, 1).AutoFill Destination:=Range("R" & r - 1).Resize(s + 1, 1), Type:=xlFillDefault
For d = 1 To c - 5
Range("A" & d + 5) = d
Next
'Range("A6").FormulaR1C1 = "=MAX(R2C:R[-1]C)+1"
'    Range("A6").AutoFill Destination:=Range("A3:A" & (c + s))

'Range("A6:A" & c) = Range("A6:A" & c).Value
Application.ScreenUpdating = True
End Sub

وصدقني عاجز عن الشكر لشخصك الكريم

انت ومن تفاعل

وبالانتظار

 

 

.

تم تعديل يناير 15, 2017 بواسطه محمد عبدالرحمن 1

[محمد عبدالرحمن 1]

ياكرام ساعدوني بارك الله فيكم

امـــــــــــ بنتظاركم ــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

 

[أبوعيد]

تفضل

 

إضافة صفو ف بالاكواد والتنسيق2.rar

[محمد عبدالرحمن 1]

استاذ ابوعيد

عندما اضغط اضافة

تظهر هذه النافذة

[محمد عبدالرحمن 1]

استاذ ابوعيد

اين انت

 بارك الله فيك

امـــــــــــ بنتظارك ــــــــــــــــــــل

المساعـــــــــــــــــــــــــــــــــــــدة

[أبوعيد]

جاري النظر في المشكلة

 

تم تعديل يناير 16, 2017 بواسطه أبوعيد

[محمد عبدالرحمن 1]

استاذ

ابوعيد

اين

انت

بنتظارك 

[محمد عبدالرحمن 1]

 صبحكم الله بالخير والسرور والرضا والنعيم جميعا