اضافة اسطر محددة العدد بنفس التنسيق

[قصي]

وجدت كودا رائعا للاستاذ خبور

يخص اضافة سطر بنفس التنسيق

ولكننا في حاجة لتعديل علي الكود ليعمل وفقا لعدد محدد

هذا الكود مفيد في اعمال كثيرة منها

شيت المرتبات عدد الموظفين محدد

والف شكر

[konafa4000]

السلام عليكم

جرب الكود البسيط المرفق بالملف

يتيح لك ادخال العدد المطلوب من الصفوف التى تريد ادراجها بحجم معين للصف

KONAFA4000

لاداراج صفوف بحجم معين.rar

[konafa4000]

وهذا الكود

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

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

Konafa4000

لاداراج صفوف بحجم معين.rar

تم تعديل أغسطس 27, 2010 بواسطه konafa4000

[inas aly]

جزاك الله خيرا

كودك رائع ولكن كبف يحافظ على التنسيق وعلى المعادلات الموجوده في الصف

تم تعديل أغسطس 27, 2010 بواسطه inas aly

[konafa4000]

السلام عليكم

جرب هذا المرفق

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

ولكن بدون المعادلات (اعمل عليهاساحاول)

اليك المرفق

ادراج صفوف لاسفل بنفس التنسيق.rar

[inas aly]

الف الف شكر

قربنا نوصل لكود ينسخ الصف بتنسيقاته ومعادلاته

جزاك الله كل خير

[قصي]

جزاك الله كل خير

كل عام وانت طيب

في انتظار نقل المعادلات ايضا

[علي فاهم]

كود صغير ومفيد

لو تكمل اضافة نسخ المعادلات

جزاك الله الف خير

[konafa4000]

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

اولا اتأسف على التأخير،

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

ثالثا : اطلب مراجعه من الاستاذ خبور خير

ارجوا ان ينال اعجابكم

konafa4000

ادراج صفوف لاسفل بنفس والمعادلات التنسيق.rar

[عبدالله باقشير]

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

بارك الله فيك اخي كنافة

Option Explicit


'******************************************************

'  تعيين نطاق الخلايا التي يتم نسخها

Private Const MyRng_Copy As String = "B4:I4"

'------------------------------------------------------

' MyRng_Copy تعيين رقم العمود من النطاق

'   الذي سياخذ منه آخر صف للصق

Private Const MyColumn As Integer = 4

'******************************************************


Sub Kh_Insert_Rows()

On Error Resume Next

Dim MyRow As Integer, LastRow As Integer

MyRow = 1

MyRow = Application.InputBox(Prompt:=" ادخل عدد الصفوف " & Chr(10) & "عدد الصفوف الافتراضية " & MyRow, Title:="ادراج عدد محدد من صفوف ", Default:=MyRow, Type:=1)

If MyRow = False Then Exit Sub

With Range(MyRng_Copy)

    LastRow = Range(.Cells(1, MyColumn), .Cells(1, MyColumn).End(xlDown)).Rows.Count

    .Copy

    With .Offset(LastRow, 0).Resize(MyRow, .Columns.Count)

        .PasteSpecial xlPasteAll

        .SpecialCells(xlCellTypeConstants).ClearContents

    End With

    .Columns(1).Offset(LastRow, 0).Select

End With

Application.CutCopyMode = False

MsgBox "تم ادراج الصفوف المطلوبة بنجاح", 524288 + 1048576, "الحمدلله"

On Error GoTo 0

End Sub

ادراج صفوف لاسفل بنفس والمعادلات التنسيق.rar

[قصي]

اه ياعم خبور ياشمعه منوره في السما والارض ان شاء الله

جزاك الله كل خير

[konafa4000]

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

شكر اخ خبور خير

منك دائما نستفيد

قال عمر بن الخطاب رضي الله عنه:

(تعلموا العلم، وعلموه الناس، وتعلموا له الوقار والسكينة وتواضعوا لمن تعلمتم منه ولمن علمتموه، ولا تكون جبارة العلماء فلا يقوم جهلكم بعلمكم)

تلميذ المنتدى

konafa4000

تم تعديل أغسطس 28, 2010 بواسطه konafa4000

[ابوعماد]

يا عم خبور خير

كلمة ابداع قليله

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

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

اخوك ابوعماد

[علي فاهم]

ممكن زر مسح للبيانات مع حمايه المعادلات من المسح

لاننا ولابد سنغبر الاسماء ونمسح الصفحة ونريد ان نحمي المعادلات

جزاك الله خيرا

[عبدالله باقشير]

السلام عليكم

ملحوظة :

لمن حمل الملف قبل المشاركة هذه

يقوم بتحميل الملف مرة اخرى

لانني في الملف السابق نسيت ان اربط الثابت MyRng_Copy

بالخلايا داخل الكود

اويعدل السطر

With Range("B4:I4")

بهذا

With Range(MyRng_Copy)

تقبلوا تحياتي وشكري

[عبدالله باقشير]

السلام عليكم

تم اضافة زر للمسح

وبعض التعديلات لكود الاضافة

Option Explicit


'******************************************************

'  تعيين نطاق الخلايا التي يتم نسخها

Private Const MyRng_Copy As String = "B4:I4"

'------------------------------------------------------

' MyRng_Copy تعيين رقم العمود من النطاق

'   الذي سياخذ منه آخر صف للصق

Private Const MyColumn As Integer = 4

'******************************************************


Sub Kh_Insert_Rows()

On Error Resume Next

Dim MyRow As Integer, LastRow As Integer

MyRow = 1

MyRow = Application.InputBox(Prompt:=" ادخل عدد الصفوف " & Chr(10) & "عدد الصفوف الافتراضية " & MyRow, Title:="ادراج عدد محدد من صفوف ", Default:=MyRow, Type:=1)

If MyRow = False Then Exit Sub

With Range(MyRng_Copy)

    LastRow = Range(.Cells(1, MyColumn), .Cells(1, MyColumn).End(xlDown)).Rows.Count

    If LastRow = 0 Then LastRow = 1

    .Copy

    With .Offset(LastRow, 0).Resize(MyRow, .Columns.Count)

        .PasteSpecial xlPasteAll

        .SpecialCells(xlCellTypeConstants).ClearContents

    End With

    .Columns(1).Offset(LastRow, 0).Select

End With

Application.CutCopyMode = False

MsgBox "تم ادراج الصفوف المطلوبة بنجاح", 524288 + 1048576, "الحمدلله"

On Error GoTo 0

End Sub



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

Sub Kh_Clear_Rows()

On Error Resume Next

Dim LastRow As Integer

With Range(MyRng_Copy)

    LastRow = Range(.Cells(1, MyColumn), .Cells(1, MyColumn).End(xlDown)).Rows.Count

    .SpecialCells(xlCellTypeConstants).ClearContents

    If LastRow = 0 Then GoTo 1

    .Cells(2, 1).Resize(LastRow, .Columns.Count).Clear

End With

1:

MsgBox "تم المسح بنجاح", 524288 + 1048576, "الحمدلله"

On Error GoTo 0

End Sub

ادراج صفوف لاسفل بنفس والمعادلات التنسيق.rar

[inas aly]

استاذ خبور

الف شكر الف شكر

جزاك الله كل خير

استاذ كنافه

الف شكر الف شكر

جزاك الله كل خير

[konafa4000]

استاذ ونحن تلاميذك

تلميذ المننتدى

konafa4000

[Mr Said]

يعطيك الف عافيه استاذنا المبدع .. ربي يحفظك ويحميك

وفقك الله لما يحب ويرضى دوما

خمس على خمس

كل الود والتحيه

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

حتى لاتطهر الفورمه الاولى التي تسألنا عن عدد لسظر

[الشاب يوسف]

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

[أحمد فؤاد]

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

وكل عام وأنتم بخير

قال عمر بن الخطاب رضي الله عنه:

(تعلموا العلم، وعلموه الناس، وتعلموا له الوقار والسكينة وتواضعوا لمن تعلمتم منه ولمن علمتموه، ولا تكون جبارة العلماء فلا يقوم جهلكم بعلمكم)

أستاذنا الكبير / عبدالله باقشير

رائع جدا الكود بارك الله فيك

[مهند 2002]

الاستاذ " عبد الله باقشير "

افدتنا افادك الله .......... ابداع وعطاء بلا حدود

من خلالك ومن خلال ما لمسناه من عطائك غير المحدود ( حماك المولى تعالى )

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

[إبراهيم ابوليله]

الاخوه الكرام بارك الله فيكم جميعا

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

[الشهابي]

أنا مع رأي أخي yousifsamra وهو

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

أتمنى من الأستاذ عبد الله باقشير أو أحد الأخوة الخبراء يقو م بذلك

وجزاكم الله خير

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

السلام عليكم

اخي الشهابي

ولو ان تعديلي لا يقارن بعلم الاستاذ عبدالله باقشير

لكن

جرب هذا التعديل

Sub Kh_Clear_Rows()

On Error Resume Next

Dim LastRow As Integer, T As Integer

With Range(MyRng_Copy)

T = Application.InputBox(Prompt:=" ادخل عدد الصفوف التي تريد حذفها " & Chr(10) & "عدد الصفوف الافتراضية " & 1, Title:="ادراج عدد محدد من صفوف ", Default:=1, Type:=1)

    LastRow = Range(.Cells(1, MyColumn), .Cells(1, MyColumn).End(xlDown)).Rows.Count

    .SpecialCells(xlCellTypeConstants).ClearContents

    If LastRow = 0 Or T > LastRow Then GoTo 1

    .Cells(LastRow - T + 1, 1).Resize(T, .Columns.Count).Clear

End With

1:

MsgBox "تم المسح بنجاح", 524288 + 1048576, "الحمدلله"

On Error GoTo 0

End Sub