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

الله يفتح عليك يا طاير كل سنة و أنت طيب

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

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

الكتابة على سطرين فى المسج بوكس MsgBox "Hello" & vbCr & Application.UserName

تلميح ع الماشى لعرض النموذج مع إمكانية التعامل مع الشيت UserForm1.Show vbModeless يعنى يظهر الفورم وتتعامل مع الشيت بنفس الوقت و تعدل فيه

السلام عليكم عندنا - أقصد كا عندنا مشكلة وتم حلها بطريقتين المشكلة أن المستخدم يكتب فى تيكست بوكس و عند الحفظ تلصق القيمة التى أدخلها فى التيكست بوكس إلى خلايا فيها معادلات فيؤدى ذلك إلى مسح المعادلة فى الشيت الحل كان بطريقتين الأولى إعادة لصق المعادلة من الخلية التالية فهذا علاج للمشكلة بعد وقوعها وهذا ابتكرته أنا وبعد ذلك وجدت طريقتك وهى تقطع الطريق أصلا على المستخدم للعبث بتيكست تلغى المعادلة فى الشيت وطبعا الطريقة الثانية أفضل بكثير ثانيا هذا هو الكود أعدته باللغة العربية فقل رأيك فيه 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 "المصروفات" .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

عليكم السلام ورحمة الله أستاذنا الفاضل خبور كم شجعتنى كلماتك على مواصلة الطريق مع ما فيه من تعب و أشكر لك سعة صدرك و إن شاء الله يكون تعليمك لى فى ميزان حسناتك ويكون ما أتعلمه نافعا للمسلمين نحن نستخدم هذه البرامج فى المدارس ومن يطلبها منا نعطيها له فتكون رحمة من الله على موظفين و مدرسين يرهقون جدا بدون هذه البرامج -- يجب أن يدخل إخوة للموضوع ويعرضوا أسئلتهم وبهذا يكون أكبر موضوع بتاريخ المنتدى === لنعد للعمل أحيانا يطلب منك عمل كشف أو تقرير بالمحولين للمدرسة أو المحولين منها أو الطلاب المرضى أو ... و كل هذا طبعا مدون فى السجل الرئيس لكل طالب قمت بعمل فورم هذه صورته به قائمة بأسماء بعض الشيتات بالملف بنفس أسماء التقارير السابقة و به زر لعمل تقارير من الشيت الرئيس يرحل لهذه الشيتات و هذه صورة التقرير بعد إنشائه أريد عرضه عليك 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

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

مرحبا المتغير iRow معلن عنه فى الثوابت فى بداية البرنامج وقيمته = 4

السلام عليكم --- هذا بروسيدور مثل وظيفة يستدعى من أى مكان فى البرنامج بذكر اسمه + المتغير المطلوب وهو iColumn السطر الأول : الإعلان عن متغيرين الأول رقم طويل يناسب عدد الصفوف و الثانى رقم يناسب عدد الأعمدة المطلوب نسخها السطر الثانى : يحدد آخر عمود فى شيت فاضى و نزيد 1 لنحصل على b4 السطر الثالث : حلقة مع الكائن MyRng تنفذ الآتى 1 - تحديد آخر صف فى الكائن " المدى " المنسوخ منه MyRng 2 - الخلية b4 نوسعها حتى تصل لنهاية العمود حتى آخر صف به بيانات ( RCount) 3 - ننسخ فيها من المدى MyRng الصف الأول و العمود الذى تستدعى به (icolumn ) و نوسع الصف ليصل لآخر صف يعنى نسخ العمود بالكامل أخيرا يتكرر هذا حسب الطلب من خارج البروسيدور بعدد العناوين المختارة بمربعات الاختيار و هذا الكود بالكامل ينفذ فى الشيت النشط ما عدا المدى MyRng حيث تنسخ منه البيانات ----- يا ترى العلامة كم ؟

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

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

الأول نعم هذا ما قصدته لكى تنسخ أى مدى فى شيت فليس ضروريا أن تحدد الشيت الموجود فيه المدى أو المدى نفسه فالكود 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 نحن معك للآن و فهمنا الكثير جدا ونشكر لك صبرك علينا إن كثيرين يتابعون هذه الأسئلة عن كثب وينتظرون إجاباتها من حضرتكم لكنى أنا كبش الفداء أسأل نيابة عنهم جزاك الله خيرا

أفادكم الله -------- أفهم من ذلك أنه لا رابط بين النسخ و التحديد بمعنى أننى يمكن أن أنسخ مدى فى أى شيت ولايستلزم ذلك تحديده كما حدث هنا ---- و السبب الوحيد للصق فى شيت التقرير هو أنه محدد SELECT فى الجملة With Sheets(Sh_Report) .Select ولولا هذا لنسخ بأى مكان حسب الشيت المحدد النسخ مرتبط بشيت الداتا .Cells(1, iColumn).Resize(RCount, 1).Copy أما اللصق فمرتبط بالشيت المحدد بدون نقطة Cells(irow, C).PasteSpecial xlPasteColumnWidths أفادكم الله وبارك فيكم وإلى سؤال آخر ما فائدة .PageSetup.PrintArea = "" فى كود تحديد المدى

السلام عليكم أستاذنا ها قد بدأت الأسئلة أعانك الله --- فى هذا الكود 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 أنا ألاحظ أن النسخ و اللصق فى مكان واحد النسخ من شيت البيانات و اللصق فى شيت التقرير أين هذا التمييز ؟ يعنى مفروض أننا ننسخ من شيت البيانات ونلصق فى شيت التقرير فأين تحديد ذلك فى الكود أرجو أن يكون سؤالى واضحا وفقك الله

لا احنا كده اطمنا خلاص ما دام فيها ريسان " أظن جمع راس" يبقى تمام أما الأسئلة فتأتى فى حينها بإذن الله طبعا أنا عندى سؤال كبير لا أحب أن ترد عليه الآن خذ وقتك وكنت سألته من قبل فى هذا المنتدى لاحظت أن الفرق بين شغلك و شغلنا أو الآخرين هو تنظيم العمل و ما أردته هو معرفة كيف تبدأ فى حل المشكلة بطريقة منظمة هل هناك تسلسل و قواعد تتبعها ذهنيا لهذا هل تكتب خطوات الحل ؟ ثم تنشئ لها الأكواد لا تجب الآن على هذه الأسئلة خذ وقتك وجهز لنا الإجابة و نعرف أنك لا تبخل بالأسرار بدليل أنك لا تساهم بأكواد مشفرة أبدا بل كل أكوادك متاحة للجميع ننتظر الكنوز ---- أما الرمضانيات فقد شاهدتها وإن كنت لا أعرف من أين أتت لا أجد أكوادا و لا غيره عموما أنا عاكف على دراسة القسم الثانى من إعداد الكشوف المدرسية وهو لصق التقرير بدأت فى دراسته أمس انتظر أنت أسئلتى إن شاء الله وكل عام أنتم بخير

حمدا لله على سلامة أستاذنا و معلمنا الأستاذ خبور عسى ما زعلناك فى شىء يشهد الله أننا نكن لك كل احترام و تقدير ==== لعل الأستاذ يقصد رأس و تذييل ديناميكى يأخذ اسم المدير و الوكيل و غيرهما من مرجع يعنى عند إدخال بيانات المدرسة ندخل اسم المدير و الوكيل فيتغير التذييل و الرأس تبعا لذلك و اسمح لى الصفوف المكررة لأعلى مختلفة عن الرأس و التذييل فالأولى فى جسم الشيت والأخيرة فى هامشه العلوى " الرأس" ---- لا تبتعد كثيرا عن موضوعنا هذا أستاذ خبور فما زالت هناك أسئلة كثيرة تنتظرك جزاك الله خيرا

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

هذا نفس الملف أضفت إليه كود الرأس و التذييل ستجد ذلك عند معاينة الطباعة رقم الصفحة أعلى اليسار أسفل يمين اللجنة : أسفل وسط : وكيل ش ط + اسمه من الورقة 1 أسفل يسار مدير المدرسة + اسمه مجلوب من الورقة 1 اعداد تقارير مدرسية - مع الرأس والتذييل.zip

أستاذنا خبور تحفة فنية تحتاج للدراسة === لماذا تركت موضوعنا ؟ ننتظرك فى الكشوفات المدرسية

شكرا أستاذ أيسم ع المعلومات

هذا كود ينفذ الآتى 1 - رأس الصفحة الأيسر = رقم الكشف 2 - التذييل الأيمن = كلمة " اللجنة " 3 - التذييل الأيسر = كلمة " مدير المدرسة " + مرجع لاسم المدير نفسه ضع الكود فى workbook -- open Private Sub Workbook_Open() With Sheets("هنا اسم الشيت الذى فيه البيانات").PageSetup .LeftHeader = "&""-,غامق""&12كشف رقم : &P" .LeftFooter = "&""-,غامق""&16مدير المدرسة" & " / " & Sheets(1).Range("f7") .RightFooter = "&""-,غامق""&16اللجنة :" End With End Sub

مجرد مشاركة بجوارالأساتذة =SUMIF($G$3:$G$367;ROW()-7;$E$3:$E$367) معادلة صفيف المرفق sum for a month-kemas.zip

كلام الأستاذ مضبوط نريد درسا مبسطا فى رأس و تذييل الصفحة طبعا بالأكواد فى انتظار أن يعود المعلم