شرح اعداد كشوفات مدرسية باختيار روؤس الاعمدة عن طريق فورم

[عبد الفتاح كيرة]

هذا نفس الملف

أضفت إليه كود الرأس و التذييل

ستجد ذلك عند معاينة الطباعة

رقم الصفحة أعلى اليسار

أسفل يمين اللجنة :

أسفل وسط : وكيل ش ط + اسمه من الورقة 1

أسفل يسار مدير المدرسة + اسمه مجلوب من الورقة 1

اعداد تقارير مدرسية - مع الرأس والتذييل.zip

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

[عبد الفتاح كيرة]

يبدو أن الأستاذ خبور مشغول هذه الأيام

علينا الانتظار

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

السلام عليكم

الراس والتذييل

لا يحتاجا الى كود

قم باضافتهم مرة واحدة يدويا

ولن يتغيروا الا اذا قمت انت بتعديلهم مرة اخرى

في ملفنا هذا لا يحتاج الى راس

لانه سيكرر الصفوف الاولى مع رؤوس الاعمدة في كل صفحات الطباعة

واذا اردت اضافة تذييل يمكنك اضافته مرة واحدة فقط

شاهد المرفق فيديو لاضافة تذييل

Kh_PageSetup.rar

[عبد الفتاح كيرة]

حمدا لله على سلامة أستاذنا و معلمنا الأستاذ خبور

عسى ما زعلناك فى شىء

يشهد الله أننا نكن لك كل احترام و تقدير

====

لعل الأستاذ يقصد

رأس و تذييل ديناميكى

يأخذ اسم المدير و الوكيل و غيرهما

من مرجع

يعنى عند إدخال بيانات المدرسة

ندخل اسم المدير و الوكيل

فيتغير التذييل و الرأس تبعا لذلك

و اسمح لى

الصفوف المكررة لأعلى مختلفة عن الرأس و التذييل

فالأولى فى جسم الشيت

والأخيرة فى هامشه العلوى " الرأس"

----

لا تبتعد كثيرا عن موضوعنا هذا أستاذ خبور

فما زالت هناك أسئلة كثيرة تنتظرك

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

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

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

السلام عليكم

لا تبتعد كثيرا عن موضوعنا هذا أستاذ خبور

فما زالت هناك أسئلة كثيرة تنتظرك

بالنسبة لموضوع التذاييل والريسان انت قمت بالواجب وزيادة

(التذاييل والريسان) هذه لهجة بلدنا حضرموت

طبعا انكت معاك شوية علشان تعرف اننا مش زعلان ولا حاجة

وايه في الدنيا هذه يحتاج الزعل كلها فانية

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

اين الاسئلة انا في انتظارها؟؟

وهذه هدية علشان تضحكك

وعلى فكرة برضوه الهدية دي عايزة شرح

انت معايا

رمضانيات.rar

[عبد الفتاح كيرة]

لا

احنا كده اطمنا خلاص

ما دام فيها ريسان

" أظن جمع راس"

يبقى تمام

أما الأسئلة فتأتى فى حينها بإذن الله

طبعا أنا عندى سؤال كبير

لا أحب أن ترد عليه الآن

خذ وقتك

وكنت سألته من قبل فى هذا المنتدى

لاحظت أن الفرق بين شغلك و شغلنا أو الآخرين

هو تنظيم العمل

و ما أردته هو معرفة

كيف تبدأ فى حل المشكلة

بطريقة منظمة

هل هناك تسلسل و قواعد تتبعها ذهنيا لهذا

هل تكتب خطوات الحل ؟

ثم تنشئ لها الأكواد

لا تجب الآن على هذه الأسئلة

خذ وقتك

وجهز لنا الإجابة

و نعرف أنك لا تبخل بالأسرار

بدليل أنك لا تساهم بأكواد مشفرة أبدا

بل كل أكوادك متاحة للجميع

ننتظر الكنوز

----

أما الرمضانيات فقد شاهدتها

وإن كنت لا أعرف من أين أتت

لا أجد أكوادا و لا غيره

عموما أنا عاكف على دراسة القسم الثانى من إعداد الكشوف المدرسية

وهو لصق التقرير

بدأت فى دراسته أمس

انتظر أنت أسئلتى

إن شاء الله

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

[عبد الفتاح كيرة]

السلام عليكم أستاذنا

ها قد بدأت الأسئلة

أعانك الله

---

فى هذا الكود

With MyRng

  RCount = .Cells(.Rows.Count, 1).End(xlUp).Row

   .Cells(1, iColumn).Resize(RCount, 1).Copy

    Cells(irow, C).PasteSpecial xlPasteColumnWidths

    Cells(irow, C).PasteSpecial xlPasteFormats

    Cells(irow, C).PasteSpecial xlPasteValues

    Application.CutCopyMode = False

End With

أنا ألاحظ أن النسخ و اللصق فى مكان واحد

النسخ من شيت البيانات

و اللصق فى شيت التقرير

أين هذا التمييز ؟

يعنى مفروض أننا ننسخ من شيت البيانات

ونلصق فى شيت التقرير

فأين تحديد ذلك فى الكود

أرجو أن يكون سؤالى واضحا

وفقك الله

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

السلام عليكم أستاذنا

ها قد بدأت الأسئلة

أعانك الله

---

فى هذا الكود

With MyRng

  RCount = .Cells(.Rows.Count, 1).End(xlUp).Row

   .Cells(1, iColumn).Resize(RCount, 1).Copy

    Cells(irow, C).PasteSpecial xlPasteColumnWidths

    Cells(irow, C).PasteSpecial xlPasteFormats

    Cells(irow, C).PasteSpecial xlPasteValues

    Application.CutCopyMode = False

End With

أنا ألاحظ أن النسخ و اللصق فى مكان واحد النسخ من شيت البيانات و اللصق فى شيت التقرير أين هذا التمييز ؟ يعنى مفروض أننا ننسخ من شيت البيانات ونلصق فى شيت التقرير فأين تحديد ذلك فى الكود أرجو أن يكون سؤالى واضحا وفقك الله

=================================== وماذا تفعل With

With

    .<تعليمات>

End With

تنفذ عدد من الاجراءات على غرض ما =================================== MyRng هي الخلايا المنسوخة وهي مربوطة بالغرض بداية الكود

With Sheets(Sh_MyDate)

    Set MyRng = .Range(MyRng_MyDate)

End With

هذه الاجراءات الخاصة MyRng التي تبدأ بنقطة

With MyRng

  RCount = .Cells(.Rows.Count, 1).End(xlUp).Row

   .Cells(1, iColumn).Resize(RCount, 1).Copy

End With

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

With Sheets(Sh_Report)

    .Select


End With

خبور خير

[عبد الفتاح كيرة]

أفادكم الله

--------

أفهم من ذلك

أنه لا رابط بين النسخ و التحديد

بمعنى أننى يمكن أن أنسخ مدى فى أى شيت

ولايستلزم ذلك تحديده

كما حدث هنا

----

و السبب الوحيد للصق فى شيت التقرير

هو أنه محدد

SELECT

فى الجملة

With Sheets(Sh_Report)

    .Select

ولولا هذا لنسخ بأى مكان حسب الشيت المحدد النسخ مرتبط بشيت الداتا

.Cells(1, iColumn).Resize(RCount, 1).Copy

أما اللصق فمرتبط بالشيت المحدد بدون نقطة

Cells(irow, C).PasteSpecial xlPasteColumnWidths

أفادكم الله وبارك فيكم وإلى سؤال آخر ما فائدة

.PageSetup.PrintArea = ""

فى كود تحديد المدى

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

السلام عليكم

أفهم من ذلك

أنه لا رابط بين النسخ و التحديد

بمعنى أننى يمكن أن أنسخ مدى فى أى شيت

ولايستلزم ذلك تحديده

اذا كنت قاصدا ان

ده الكود مثلا:

Sheets("ورقة2").Select

    Range("A3:E11").Select

    Selection.Copy

هو نفسه ده:

Sheets("ورقة2").Range("A3:E11").Copy

فهذا صحيح اما هذا :

أما اللصق فمرتبط بالشيت المحدد بدون نقطة

كيف بدون نقطة؟؟؟؟ لازم للصق تعيين خلية واحدة

Cells(irow, C)

هذه خلية اللصق

هنا لم تعين ورقة اللصق فقط

وتاخذ افتراضيا ActiveSheet

الورقة التي واقف عليها

مفهوم الى حد هنا ؟؟؟

[عبد الفتاح كيرة]

الأول نعم

هذا ما قصدته

لكى تنسخ أى مدى فى شيت

فليس ضروريا أن تحدد الشيت الموجود فيه المدى

أو المدى نفسه

فالكود

Sheets("ورقة2").Range("A3:E11").Copy

نسخ المدى بالرغم من عدم تحديده لذلك لم ننتقل لشيت2 إلا إذا كان نشطا فى الأصل أما النقطة التى أقصدها فهى التى تفيد أن ما بعدها من خصائص كائن معين يعنى

.Cells(1, iColumn).Resize(RCount, 1).Copy

النقطة معناها

MyRng.Cells(1, iColumn).Resize(RCount, 1).Copy

أما كود اللصق فبدون نقطة فهو مدى عام

 Cells(irow, C).PasteSpecial xlPasteColumnWidths

نحن معك للآن

و فهمنا الكثير جدا

ونشكر لك صبرك علينا

إن كثيرين يتابعون هذه الأسئلة عن كثب

وينتظرون إجاباتها

من حضرتكم

لكنى أنا كبش الفداء

أسأل نيابة عنهم

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

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

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

السلام عليكم

يعني انا فهمت قصدك خطا

حقك علي

وإلى سؤال آخر

ما فائدة

.PageSetup.PrintArea = ""

فى كود تحديد المدى

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

[عبد الفتاح كيرة]

ممتاز جدا إجابة هذا السؤال

وضعنا فى الاعتبار

وجود تقرير سابق

ومدى طباعة مختلف

---

الأستاذ لا يقول للتلاميذ حقك علينا

والتلاميذ يفعلون

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

وإلى لقاء مع استفسارات أخرى

[عبد الفتاح كيرة]

هذا الموضوع ناجح بفضل الله

ثم بفضل الأستاذ خبور

المشاهدات كثيرة جدا

فى فترة وجيزة

يقارب ثلث مشاهدات الموضوعات المثبتة مجتمعة

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

السلام عليكم

اختبار تحريري

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

Private Sub Kh_Start(iColumn As Integer)

Dim RCount As Long, C As Integer

C = Cells(iRow, Columns.Count).End(xlToLeft).Column + 1

With MyRng

    RCount = .Rows.Count

    Cells(iRow, C).Resize(RCount, 1).Value = _

    .Cells(1, iColumn).Resize(RCount, 1).Value

End With

End Sub

اريد شرحا مفصلا ؟

العلامة 100

خبور خير

[عبد الفتاح كيرة]

السلام عليكم

---

هذا بروسيدور مثل وظيفة

يستدعى من أى مكان فى البرنامج بذكر اسمه + المتغير المطلوب

وهو iColumn

السطر الأول : الإعلان عن متغيرين الأول رقم طويل يناسب عدد الصفوف و الثانى رقم يناسب عدد الأعمدة المطلوب نسخها

السطر الثانى : يحدد آخر عمود فى شيت فاضى و نزيد 1 لنحصل على b4

السطر الثالث : حلقة مع الكائن MyRng تنفذ الآتى

1 - تحديد آخر صف فى الكائن " المدى " المنسوخ منه MyRng

2 - الخلية b4 نوسعها حتى تصل لنهاية العمود حتى آخر صف به بيانات ( RCount)

3 - ننسخ فيها من المدى MyRng الصف الأول و العمود الذى تستدعى به (icolumn ) و نوسع الصف ليصل لآخر صف يعنى نسخ العمود بالكامل

أخيرا

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

و هذا الكود بالكامل ينفذ فى الشيت النشط

ما عدا المدى MyRng حيث تنسخ منه البيانات

-----

يا ترى العلامة كم ؟

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

[inas aly]

السلام عليكم

اختبار تحريري

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

Private Sub Kh_Start(iColumn As Integer)

Dim RCount As Long, C As Integer

C = Cells(iRow, Columns.Count).End(xlToLeft).Column + 1

With MyRng

    RCount = .Rows.Count

    Cells(iRow, C).Resize(RCount, 1).Value = _

    .Cells(1, iColumn).Resize(RCount, 1).Value

End With

End Sub

اريد شرحا مفصلا ؟

العلامة 100

خبور خير

---

السلام عليكم

هذا بروسيدور مثل وظيفة

يستدعى من أى مكان فى البرنامج بذكر اسمه + المتغير المطلوب

وهو iColumn

السطر الأول : الإعلان عن متغيرين الأول رقم طويل يناسب عدد الصفوف و الثانى رقم يناسب عدد الأعمدة المطلوب نسخها

السطر الثانى : يحدد آخر عمود فى شيت فاضى و نزيد 1 لنحصل على b4

السطر الثالث : حلقة مع الكائن MyRng تنفذ الآتى

1 - تحديد آخر صف فى الكائن " المدى " المنسوخ منه MyRng

2 - الخلية b4 نوسعها حتى تصل لنهاية العمود حتى آخر صف به بيانات ( RCount)

3 - ننسخ فيها من المدى MyRng الصف الأول و العمود الذى تستدعى به (icolumn ) و نوسع الصف ليصل لآخر صف يعنى نسخ العمود بالكامل

أخيرا

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

و هذا الكود بالكامل ينفذ فى الشيت النشط

ما عدا المدى MyRng حيث تنسخ منه البيانات

-----

اردت ان اجمع السؤال والاجابه للتمعن فيهم

بدأت افهم حاجه

من اين عرفت اننا في خليه B4

[عبد الفتاح كيرة]

مرحبا

المتغير

iRow

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

وقيمته = 4

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

السلام عليكم

السطر الثالث : حلقة مع الكائن MyRng تنفذ الآتى

لا توجد حلقة هنا

وانما مجموعة اجراءات ستنفذ على الغرض MyRng

العلامة 95

ملحوظة:

في هذا الكود ما في عندنا نسخ ولا لصق

وانما تنتقل بالطريقة ربط قيمة Value

قيم خلايا معينة = قيم خلايا مغينة

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

مثال لخلية واحدة

[code]Range("E16").Value = Range("E5").Value

Range("D16:G16").Value = Range("D5:G5").Value

[inas aly]

بعد اذن الاستاذ خبور

اريد طريقة ادخال للبيانات في صفحة ALL

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

اطار ادخال.rar

[عبد الفتاح كيرة]

علامة مشرفة

لا أستحقها

ما زلنا على الدرب نبدأ المشوار

شكرا لكرمك

العبارة ليس فيها نسخ

نعم

لكن المحصلة واحدة

بالنسخ أو بتساوى القيمة

بارك الله فيك

وجزاك عنا خيرا

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

السلام عليكم

بعد اذن الاستاذ خبور

اريد طريقة ادخال للبيانات في صفحة ALL

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

شاهدي المرفق

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

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

وايضا اثناء حفظ التغييرات يتجاوز الخلايا ذات المعادلات

وهذا اجراء مهم جدا

لانه سيحول جميع المرحل الى قيم بدون التمييز اذا كان معادلة اوغيره

22المرتبات.rar

[inas aly]

الف الف شكر على كل اعمالك واقوالك

لو حبيت اجعل الصف الثالث الموجود في صفحة ALL

اجعله الصف الخامس فين الجزئيه الخاصة بذلك ؟

كيف اجعل عدد الاعمدة اكثر وتاتي في الفريم

هل ممكن وضع صورة للشخص في الفريم

وتتغير الصوره بتغير الشخص

[عبد الفتاح كيرة]

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

أستاذنا الفاضل خبور

كم شجعتنى كلماتك على مواصلة الطريق

مع ما فيه من تعب

و أشكر لك سعة صدرك

و إن شاء الله يكون تعليمك لى فى ميزان حسناتك

ويكون ما أتعلمه نافعا للمسلمين

نحن نستخدم هذه البرامج فى المدارس

ومن يطلبها منا نعطيها له

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

--

يجب أن يدخل إخوة للموضوع

ويعرضوا أسئلتهم

وبهذا يكون أكبر موضوع بتاريخ المنتدى

===

لنعد للعمل

أحيانا يطلب منك عمل كشف أو تقرير

بالمحولين للمدرسة

أو المحولين منها

أو الطلاب المرضى أو ...

و كل هذا طبعا مدون فى السجل الرئيس لكل طالب

قمت بعمل فورم

هذه صورته

به قائمة بأسماء بعض الشيتات بالملف بنفس أسماء التقارير السابقة

و به زر لعمل تقارير من الشيت الرئيس يرحل لهذه الشيتات

و هذه صورة التقرير بعد إنشائه

أريد عرضه عليك

Dim MyData As Range

Dim mysheetsN As String

Dim mycol As Integer

Private Sub CommandButton1_Click()

Dim sss As String

Dim dd As Integer

sss = sheetsNames.Value

Dim gh As Integer

gh = sheetsNames.ListIndex

Select Case gh


    Case 0

        dd = 21

    Case 1

        dd = 22

    Case 2

        dd = 8

    Case 3

        dd = 25

    Case 4

        dd = 23

    Case 5

        dd = 26

    Case 6

        dd = 24

    End Select

 taqreer dd, sss

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Private Sub UserForm_Initialize()

With sheetsNames

    .AddItem "ÇáãÍæáæä ááãÏÑÓÉ"

    .AddItem "ÇáãÍæáæä ãä ÇáãÏÑÓÉ"

    .AddItem "ãÚíÏæä"

    .AddItem "ãÑÖì"

    .AddItem "ÇáÃíÊÇã"

    .AddItem "ÇáÅäÐÇÑÇÊ"

    .AddItem "ÇáãÕÑæÝÇÊ"

    .ListIndex = 0

End With

End Sub

Public Function taqreer(mycol As Integer, mysheetName As String)

Dim LDataRow As Long

Sheets("All").Select

LDataRow = Cells(Rows.Count, 2).End(xlUp).Row

Dim myrow As Long

myrow = 1

Set MyData = Range(Cells(myrow, 2), Cells(LDataRow, 50))

  i = 6

Sheets(mysheetName).Select

Range("b6:c1000").ClearContents

 For myrow = 5 To LDataRow

 With MyData

      If Not IsEmpty(.Cells(myrow, mycol).Value) Then

          Cells(i, 2) = .Cells(myrow, 1)

       Cells(i, 3) = .Cells(myrow, mycol)

       i = i + 1

        End If

  End With

        Next myrow

End Function

[عبد الفتاح كيرة]

شوف الفرق بين حلول الأساتذة و حلول التلامذة

حلول الأساتذة لمنع مسح المعادلات :

If Worksheets(Sh_MyDate).Cells(4, i).HasFormula Then

            .BackColor = &HFFC0C0

            .Locked = True

        End If

حلول التلامذة : هذا بعد مسح المعادلة بالفعل تنسخ من الخلية التالية

For aa = 1 To 3

With rr

rr.Cells(1, aa).Offset(1, 0).Copy

rr.Cells(1, aa).PasteSpecial Paste:=xlPasteFormulas

Application.CutCopyMode = False

 End With