اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر (معدل)

بسم الله الرحمن الرحيم

تحية طيبة من عند الله ... وبعد

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

1 - عمل كود ترحيل البيانات من الصفحة الرئيسية إلى صفحات المواد حسب مواد الدور الثاني بمعنى ( إذا كان الطال عنده دور ثان في مادة اللغة العربية يرحل البيانات من اول رقم الجلوس و الاسم وباقسي البيانات الموجودة في صفحة اللغة العربية ) وهكذا .

2 - إذا كان الطالب عنده مااده أخرى بعد المادة التي ترحل يكتب في خانة المواد التالية عدد المواد التالية فقط أو يكتب عنده مواد تالية , وإذا لم يكن عنده مواد تالية للمادة التي ترحل يكتب ليس له مواد تاليه )

3 - عدم ترك أسطر فارغة بين البيانات المرحلة .

مرفق ملف للعمل علية

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

وأتقدم بخالص الشكر والتقدير لكم جميعًا ولكل القائمين المنتدى الغالي .

الدور الثاني.rar

تم تعديل بواسطه حاتم عيسى
قام بنشر (معدل)
53 دقائق مضت, عمر الحسيني said:

 

الاخ حاتم عيسى

شاهد المرفق

Omar_1.rar

 

بارك الله في حضرتك عمل أكثر من رائع وممتاز

ولكن هناك نقطة صغيرة وهى مسح البيانات من الصفحات المرحل إليها قبل الترحيل حتى لا يكون هناك تكرار في البيانات .

وشكرا جزيلا لحضرتك وجعل الله جميع أعمالك في موازين حسناتك ....

تم تعديل بواسطه حاتم عيسى
  • Like 1
قام بنشر (معدل)
Option Base 1

Sub Transfer_Data()
'
Dim Sh_Master As Worksheet
Dim Rng As Range
Dim Arr()
Application.ScreenUpdating = False
'======================================================================================
Set Sh_Master = Sheets("الرئيسية")
For Each Sh In Sheets
    If Sh.Name <> Sh_Master.Name Then
        Sh.Range("B7:H" & Rows.Count).ClearContents
    End If
Next
End_Row = Sh_Master.Cells(Rows.Count, "C").End(xlUp).Row
Set Rng = Sh_Master.Range("A6:N" & End_Row)
Arr = Rng
'======================================================================================
For Row = 2 To UBound(Arr)
    For Col = 7 To 12
        If Arr(Row, Col) = 1 Then
            ShName = Arr(1, Col)
            End_Row = Sheets(ShName).Cells(Rows.Count, "C").End(xlUp).Row + 1
            Set Rng = Range(Sh_Master.Cells(Row + 5, "B"), Sh_Master.Cells(Row + 5, "F"))
            Rng.Copy Sheets(ShName).Range("B" & End_Row)
            Sheets(ShName).Range("G" & End_Row) = Arr(1, Col)
            '==============================
            Sheets(ShName).Range("H" & End_Row) = Sh_Master.Cells(Row + 5, "N") - 1
            ' OR
            '            Sheets(ShName).Range("H" & End_Row) = "عنده مواد تالية"
            '==============================
        End If
    Next
Next
'======================================================================================
    Application.ScreenUpdating = True
'
End Sub

الأستاذ الفاضل المحترم الخلوق : عمر الحسيني

تحية من عند الله  ... وبعد

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

بارك الله فيك ولك وعليك

مشكووووووووووووووووووووووووووووووووور

مجهود وعمل أكثر من رائع

هل من الممكن حماية الصفحات المرحل إليها البيانات بكلمة مرور وليكن " 123 " حتى لا يتم العبث بها

وهذا هو الكود الأكثر من رائع الخاص بالترحيل والذي قمت حضرتك بعمله في الملف :

 

تم تعديل بواسطه حاتم عيسى
قام بنشر

 

لا ازعاج اخي

ولو في اي شئ اخر تحت امرك 

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

 

قام بنشر

لو أمكن من فضل حضرتك عند ترحيل البيانات للمرة الأولى تتم بنجاح وتتم حماية الصفحات

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

فما الحل ؟

قام بنشر

بفضل الله تعالى ..... ثم بفضل الأستاذ الفاضل المحترم : ياسر خليل أبو البراء

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

 

 

قام بنشر

 

الاخ حاتم عيسى

لا يمكن حدوث  ما تقول نهائيا 

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

 

فالكود في الملف

Omar_3.rar

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

اعد التجربة علي الملف

Omar_3.rar

واخبرني النتيجة

لا يمكن نهائيا حدوث هذه الرسالة 

لا يمكن نهائيا حدوث هذه الرسالة

لا يمكن نهائيا حدوث هذه الرسالة

ارجو من الاخ ياسر تجربة الملف 

Omar_3.rar

واخباري بالنتيجة

ربما اخي حاتم عيسى تكون علي حق واكون انا في غفلة من امري

 

 

 

 

قام بنشر

الأستاذ الفاضل المحترم : عمر الحسيني

تحية طيبة ... وبعد

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

فرلما كان الخطأ من الجهاز الأخر لأني كنت أجرب الملف على أوفيس 2010 وقد يكون الخطأ من هنا .

أعتذر لحضرتك شديد الاعتذار .

وبارك الله فيك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information