انشاء تقرير من صفحات متعدده

[أبوبسمله]

إخوانى الكرام 

أرجو منكم المساعده فى انشاء هذا التقرير لدى ملف لأجازات الموظفين 

هذا التقرير للموظفين اللذين لهم اجازات اكثرمن 4 ايام فى الشهر لخصم خمسه % من الأجر 

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

هناك نقطه اخيره طبعا ده جزء من الملف ارجو انه عند اضافة باقى الموظفين ان يتم فحصهم مثل الموجودين يعنى تهيئة الملف لقرائة اى موظف جديد هينضاف فى الملف

ارجو ان اكون اوضحت المطلوب بشكل مناسب 

وشكرا لكم جميعا على ماتقدمونه من تسهيل للمبتدئين أمثالى 

 

New ورقة عمل.rar

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

إليك الكود التالي عله يفي بالغرض

Sub VacationReport()
'يقوم الكود بعمل تقرير بأسماء الموظفين الذين زادت أيام الأجازات عن 4 أيام
'بفرض أن لكل موظف ورقة عمل وتبدأ أوراق عمل الموظفين من الورقة رقم 5 إلى
'آخر ورقة بالمصنف ، قم باختيار الشهر من ورقة العمل المراد عمل التقرير بها
'التي تحتوي على قائمة منسدلة بأسماء شهور السنة ثم نفذ الكود [B3] من الخلية
'-------------------------------------------------------------------------
'الإعلان عن المتغيرات
    Dim WS As Worksheet, Str As String
    Dim I As Long, Found As Range
    Dim lRow As Long
'تعيين المتغير ليساوي ورقة تقرير الخصم
    Set WS = Sheets("تقرير خصم 5%")
'تعيين المتغير ليساوي اسم الشهر الموجود بالخلية
    Str = WS.Range("B3").Value
'رقم أول صف سيتم إدراج النتائج به
    lRow = 7

'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'مسح محتويات النطاق الذي سيتم إدارج النتائج به
        WS.Range("A7:C1000").ClearContents
   
'حلقة تكرارية لأوراق العمل من الورقة رقم 5 إلى آخر ورقة عمل في المصنف
        For I = 5 To Sheets.Count
'سطر لايجاد النطاق الذي يحوي على اسم الشهر داخل ورقة العمل الخاصة بالموظف
            Set Found = Sheets(I).Columns("I:I").Find(Str)
'إذا وجد نتيجة للبحث عن اسم الشهر يتم تنفيذ الأسطر التالية
            If Not Found Is Nothing Then
'[Found] إيجاد قيمة الخلية التي تقع في العمود السابق للمتغير
'[H] أي أنها تجلب عدد إجمالي عدد أيام الأجازات من العمود
'فإذا كانت قيمة الخلية أكبر من أو يساوي 4 أيام يتم تنفيذ المطلوب وجلب البيانات
                If Found.Offset(0, -1) >= 4 Then
'في ورقة الموظف [B2] الخلية في الصف المحدد في ورقة التقرير في العمود الأول تساوي الخلية
                    WS.Cells(lRow, 1) = Sheets(I).Range("B2")
'في ورقة الموظف [A1] الخلية في الصف المحدد في ورقة التقرير في العمود الثاني تساوي الخلية
                    WS.Cells(lRow, 2) = Sheets(I).Range("A1")
'الخلية في الصف المحدد في ورقة التقرير في العمود الثالث تساوي قيمة الخلية
'التي تحتوي إجمالي الأجازات والتي تقع في العمود السابق للنطاق المتغير
                    WS.Cells(lRow, 3) = Found.Offset(0, -1)
'زيادة قيمة الصف المحدد بمقدار واحد للانتقال إلى صف جديد لإدراج بيانات جديدة
                    lRow = lRow + 1
                End If
            End If
        Next I
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

 

تم تعديل أغسطس 8, 2015 بواسطه ياسر خليل أبو البراء

[أبوبسمله]

اهلا بك اخى ياسر 

شرح جميل وميسر 

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

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

1New ورقة عمل.rar

1New ورقة عمل.rar

[أبوبسمله]

اخى الفاضل ياسر 

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

تم المطلوب بحمد الله وفضله ثم بفضل مساعدتكم لنا 

قمت بوضع الكود تحت زر امر واشتغل تمام جزاك الله كل خير 

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

 

2New ورقة عمل.rar

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

أخي الكريم يرجى تغيير اسم الظهور ليعبر عن شخصكم الكريم

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

بارك الله فيك على دعائك الطيب

تقبل تحياتي

[أبوبسمله]

اخى الكريم 

لا اعلم طريقة تغيير اسم الظهور وليست موجوده بالاعدادت الشخصيه 

الخطأ اللذى وقعت فيه اعتقدت ان الكود سيعمل اتوماتك عند اختيار الشهر المراد ظهور الموظفين به 

ولكنى وانا احاول فى الكود وباعد الضغط على زر تنفيذ الكود من شاشة محرر الاكواد وجدته نفذ الكود فعملت حينها زر امر ووضعت الكود به واشتغل تمام

اختار الشهر واضغط على زر الامر ياتى بالموظفين 

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

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

أخي الفاضل بالنسبة لتغيير اسم الظهور راجع التوجيه العاشر في التوجيهات على الرابط التالي

من هنا

الحمد لله أن قمت بالأمر وحدك حتى تتعلم من الاخطاء فلن تتعلم إلا إذا أخطأت

تقبل تحياتي