نسخ المعادلات والتنسيقات

asdhamdey · مايو 1, 2015

الاستاذ الكريم عبد الباري

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

في صفحة بيانات اساسيه وجدنا الكتابة بالخط البارز كيف تم ذلك

في صفحة الشيت الورقي يوجد زر سحري اسمه تحديث

وكوده الاتي
On Error GoTo kh_Err
تصفير_محدد

kh_Application False

'=============================================

kh_cFormula Range("شيت_الصف_الرابع!$c$2:$g$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$k$2:$L$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$p$2:$t$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$x$2:$y$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ac$2:$ag$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ak$2:$al$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ap$2:$at$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ay$2:$ba$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$bf$2:$bk$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$bo$2:$bp$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$bt$2:$bx$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ca$2:$cb$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ce$2:$ci$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$cl$2:$cm$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$cp$2:$ct$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$cw$2:$cx$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$da$2:$de$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$dh$2:$di$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$dl$2:$dr$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$dv$2:$dw$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$ea$2:$ek$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$em$2:$em$2"), 7, ورقة8.Range("b1")

kh_cFormula Range("شيت_الصف_الرابع!$eo$2:$ew$2"), 7, ورقة8.Range("b1")

'=============================================

kh_Err:

kh_Application True

If Err Then

MsgBox "Err.Number : " & Err.Number

Err.Clear

' Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله"

End If

End Sub

' MyRng : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة

' iRow : اول صف للبيانات

' Lastrow : آخر صف للبيانات

Sub kh_cFormula(MyRng As Range, iRow As Integer, Lastrow As Long)

Dim Col As Range

Dim R As Long

'========================

For Each Col In MyRng.Cells

If Col.HasFormula Then

For R = iRow To Lastrow

With MyRng.Worksheet

.Cells(R, Col.Column).FormulaR1C1 = Col.FormulaR1C1

.Cells(R, Col.Column).Value = .Cells(R, Col.Column)

End With

Next R

End If

Next

'========================

Set Col = Nothing

End Sub

Sub kh_Application(ibol As Boolean)

With Application

.ScreenUpdating = ibol

.Calculation = IIf(ibol, -4105, -4135)

.EnableEvents = ibol

End With

End Sub

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

اخى الحبيب قصى

هذا الكود .... مسئول عن نسخ المعادلات الموجوده فى الصف الثانى ذو اللون الاسود وتطبيقها على باقى الشيت ابتداء من الصف السابع

واذا اردت شرحا وافيا ....حاضر من عينيا

هذا الكود .... مسئول عن نسخ المعادلات الموجوده فى الصف الثانى

اريد اضافة نسخ التنسيقات الموجوده بنفس الصف الثاني جزاكم الله خيرا

ياسر خليل أبو البراء · مايو 1, 2015

الأخ الفاضل

يرجى مراجعة هذا الرابط وتطبيق التوجيهات

http://www.officena.net/ib/index.php?showtopic=60147

ولن يلتفت إليك الأخوة الأعضاء ما دمت لم تلتفت إلى التوجيهات (هااااام وضروري)

asdhamdey · مايو 1, 2015

هذا الكود موجود بهذا الموضوع

http://www.officena.net/ib/index.php?showtopic=58577&page=3

المشاركة 43

asdhamdey · مايو 1, 2015

الأخ الفاضل

يرجى مراجعة هذا الرابط وتطبيق التوجيهات

http://www.officena.net/ib/index.php?showtopic=60147

ولن يلتفت إليك الأخوة الأعضاء ما دمت لم تلتفت إلى التوجيهات (هااااام وضروري)

انت خلاص قررت ان الاخوة لا يلتفتوا الى موضوعي ..

عرفني ايه الحكايه الله يسامحك

تم تعديل مايو 1, 2015 بواسطه asdhamdey

ياسر خليل أبو البراء · مايو 1, 2015

والله أخي الفاضل حمدي

إنت حر

أنا مش بلزمك بشيء ومحدش يقدر يلزمك ..

بس طالما إن فيه قواعد .. يبقا صدقني الأخوة اللي بيقدموا المساعدة هيلتزموا بيها قبل الأعضاء اللي بيطلبوا المساعدة نفسهم ..دا لأنك لو ساعدت الناس الناس هتساعدك

حاجة تانية (ومش غرور مني لكن ثقة في الأعضاء ) - لو قلت بلاش نساعد فلاااااااان كله هيسمع كلامي .دا عشمي فيهم مش إجبار ليهم بردو :yes:

راجع التوجيهات بارك الله فيك والتزم بما جاء فيها قبل أي شيء ..ولو وجدت شيء لا يعجبك فيها أخبرني

asdhamdey · مايو 1, 2015

هذا هو الملف

المطلوب

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

من الصف ال11 وحتى نهايه العدد الموجود في الخليه B4

وشكرا لتوجيهاتكم يابو ضحكة جنان

نسخ المعادلات والتنسيقات.zip

asdhamdey · مايو 1, 2015

عدد الصغوف او عدد الطلاب متغير

asdhamdey · مايو 1, 2015


Sub kh_Copy_Formula()
On Error GoTo kh_Err

kh_Application False

'=============================================
kh_cFormula Range("الاول!$b$5:$b$5"), 9, ورقة19.Range("b1")
kh_cFormula Range("الاول!$n$5:$u$5"), 9, ورقة19.Range("b1")
'=============================================

kh_Err:
kh_Application True

If Err Then
    MsgBox "Err.Number : " & Err.Number
    Err.Clear
'    Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله"
End If
End Sub

' MyRng   : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة
' iRow    : اول صف للبيانات
' Lastrow : آخر صف للبيانات

Sub kh_cFormula(MyRng As Range, iRow As Integer, Lastrow As Long)
Dim Col As Range
Dim R As Long
'========================
For Each Col In MyRng.Cells
    If Col.HasFormula Then
        For R = iRow To Lastrow
            With MyRng.Worksheet
                .Cells(R, Col.Column).FormulaR1C1 = Col.FormulaR1C1
                .Cells(R, Col.Column).Value = .Cells(R, Col.Column)
            End With
        Next R
    End If
Next
'========================
Set Col = Nothing
End Sub

Sub kh_Application(ibol As Boolean)
With Application
    .ScreenUpdating = ibol
    .Calculation = IIf(ibol, -4105, -4135)
    .EnableEvents = ibol
End With
End Sub

Sub kh_Copy_Formula1()
On Error GoTo kh_Err

kh_Application1 False

'=============================================
kh_cFormula Range("الثانى!$b$5:$b$5"), 9, ورقة20.Range("b1")
kh_cFormula Range("الثانى!$n$5:$u$5"), 9, ورقة20.Range("b1")
'=============================================

kh_Err:
kh_Application1 True

If Err Then
    MsgBox "Err.Number : " & Err.Number
    Err.Clear
'    Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله"
End If
End Sub

' MyRng   : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة
' iRow    : اول صف للبيانات
' Lastrow : آخر صف للبيانات

Sub kh_cFormula1(MyRng As Range, iRow As Integer, Lastrow As Long)
Dim Col As Range
Dim R As Long
'========================
For Each Col In MyRng.Cells
    If Col.HasFormula Then
        For R = iRow To Lastrow
            With MyRng.Worksheet
                .Cells(R, Col.Column).FormulaR1C1 = Col.FormulaR1C1
                .Cells(R, Col.Column).Value = .Cells(R, Col.Column)
            End With
        Next R
    End If
Next
'========================
Set Col = Nothing
End Sub

Sub kh_Application1(ibol As Boolean)
With Application
    .ScreenUpdating = ibol
    .Calculation = IIf(ibol, -4105, -4135)
    .EnableEvents = ibol
End With
End Sub

استاذ ياسر آدي الكود والملف .. مبسوط ياعم عملت اللي عليا .. همتك بقى

asdhamdey · مايو 1, 2015

للرفع رفع الله قدركم

asdhamdey · مايو 1, 2015

المسامح كريم

ياسر خليل أبو البراء · مايو 1, 2015

أخي الكريم

الملف يحتاج لوقت لدراسته .. إن شاء الله تجد المساعدة من الأخوة الأعضاء ..

وبعدين مفيش حد زعلان منك أبداً

تقبل تحياتي

asdhamdey · مايو 2, 2015

للرفع

asdhamdey · مايو 2, 2015

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

http://www.officena.net/ib/index.php?showtopic=31449

asdhamdey · مايو 2, 2015

وهذا هو الكود

Sub KH_Copy()
On Error Resume Next
Dim Last As Long
Dim Count As Integer
Count = 1
Count = Sheets("KHBOOR").Range("F9").Value
With ActiveSheet
    Last = .Range("A" & .Rows.Count).End(xlUp).Row
    .Rows(Last).Copy .Rows(Last + 1).Resize(Count)
    .Rows(Last + 1).Resize(Count).SpecialCells(xlConstants).ClearContents
End With
On Error GoTo 0
End Sub

asdhamdey · مايو 2, 2015

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

هذا كود اخر لو تكرمتم اريد الحل في ملفي

asdhamdey · مايو 2, 2015

وهذا رابط الكود

http://www.officena.net/ib/?showtopic=33712

asdhamdey · مايو 2, 2015

المطلوب من كل هذه الاكواد المفيدة بارك الله في صانعها
هو

مطلوب كود منهم يتم تطويعه

لينسخ الصف 1000 الموجود بالملف ويتم لصقة ابتداء من الصف ال11 بالعدد الموجود في الخليه B4

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

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

عبدالباري البنا · مايو 2, 2015

الاخ العزيز .....تفضل الملف

اجريت تعديل بسيط وهو تغيير الصف المراد نسخه

من الصف 1000 الى الصف 11

تقبل تحياتى

نسخ المعادلات والتنسيقات.rar

asdhamdey · مايو 2, 2015

يبارك فيك ربنا يا استاذ عبد الباري

اولا يجب شكرك

ثانيا عند تغيير عدد الطلاب الموجود في الخليه بي 4

المفروض ان يوجد هذا العدد من الصفوف فقط مملوءه بالمعادلات والتنسيقات

الصف ال1000 ليه هو المطلوب من اجل ان يتم الاستفاده القصوى من الكود لجميع الكنترولات فبعضهم يبدأ من الصف 7 والاخر من الصف 11 والرقم متغير

اذن افضل حل هو الصف ال1000

asdhamdey · مايو 2, 2015

لو ان عدد الطلاب 500

وبعد كده اردنا ان ندخل عدد الطلاب 100 فإن الصفوف ال500 تظل مملوءه بالمعادلات

نريد ان يلتزم الكود بعدد الطلاب فقط وتمسح الصفوف الغير ذلك

عبدالباري البنا · مايو 2, 2015

لو ان عدد الطلاب 500

وبعد كده اردنا ان ندخل عدد الطلاب 100 فإن الصفوف ال500 تظل مملوءه بالمعادلات

نريد ان يلتزم الكود بعدد الطلاب فقط وتمسح الصفوف الغير ذلك

أخى العزيز

جرب المرفق

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

ويمسح باقى الصفوف

نسخ المعادلات والتنسيقات.rar

ياسر خليل أبو البراء · مايو 2, 2015

بارك الله فيك أخي وحبيبي في الله عبد الباري

كنت في بالي والله .. غبت عننا ليه لعله خير إن شاء الله

ننتظر تواجدك معنا وبيننا

asdhamdey · مايو 3, 2015

استاذ عبد الباري

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

..

الملف ممتاز ولكنه لايعمل بعد تغيير عدد الطلاب اكثر من 4 محاولات جرب وشوف

عبدالباري البنا · مايو 3, 2015

اخى العزيز اشكرك جدا على كلماتك الجميله

لكنى اقل بكثير من ان اتساوى باساتذة هذا الصرح العظيم

==============

جرب المرفق بعد التعديل واعلمنى بالنتيجة

نسخ المعادلات والتنسيقات.rar

عبدالباري البنا · مايو 3, 2015

بارك الله فيك أخي وحبيبي في الله عبد الباري

كنت في بالي والله .. غبت عننا ليه لعله خير إن شاء الله

ننتظر تواجدك معنا وبيننا

اخى واستاذى وحبيبى فى الله.... استاذ ياسر

اولا : مبروك لهذا المنتدى الرائع ترقيه استاذ كبير وعظيم مثلك وصاحب ايادى بيضاء على الجميع...مبروك

ثانيا : والله بجد وحشتونى جدا وما منعنى كان اقوى منى لكن الحمد لله قدر الله وما شاء فعل

ثالثا : اسعدنى جدا جدا جدا سؤالك عنى ....ادام الله الحب والموده بيننا وادام الله عليك فضله ونعمته

تسجيل الدخول

نسخ المعادلات والتنسيقات

الردود الموصى بها

asdhamdey

ياسر خليل أبو البراء

asdhamdey

asdhamdey

ياسر خليل أبو البراء

asdhamdey

asdhamdey

asdhamdey

asdhamdey

asdhamdey

ياسر خليل أبو البراء

asdhamdey

asdhamdey

asdhamdey

asdhamdey

asdhamdey

asdhamdey

عبدالباري البنا

asdhamdey

asdhamdey

عبدالباري البنا

ياسر خليل أبو البراء

asdhamdey

عبدالباري البنا

عبدالباري البنا

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information