أبو حنف

السلام عليكم اخواني المطلوب 1- عمل حلقة تكرارية للأكواد في الفورم 2- كود تسمية تشيك بوكس تلقائيا باسم رأس كل عامود مع ترتيهم رأسيا بشكل منتظم أو كود يقوم بالانشاء والتسمية والترتيب تلقائيا في حدث الفورم Private Sub CheckBox1_Click() ' أهنا الكود الأول خاص بوضع صح كل التشيك بوكس الموجود في الفورم أو ازالة الصح وأريد الحلقة حتي تشيك بوكس 15 مثلا If CheckBox1 = False Then CheckBox2.Value = False CheckBox3.Value = False CheckBox4.Value = False CheckBox5.Value = False CheckBox6.Value = False ElseIf CheckBox1 = True Then CheckBox2.Value = True CheckBox3.Value = True CheckBox4.Value = True CheckBox5.Value = True CheckBox6.Value = True End If End Sub Private Sub CheckBox2_Click() 'هنا الكود الثاني خاص بكل تشيك بوكس على حدة وأريد الحلقة حتي تشيك بوكس 15مثلا If CheckBox2 = False Then Columns(2).Hidden = True ElseIf CheckBox2 = True Then Columns(2).Hidden = False End If End Sub Private Sub CheckBox3_Click() If CheckBox3 = False Then Columns(3).Hidden = True ElseIf CheckBox3 = True Then Columns(3).Hidden = False End If End Sub Private Sub CheckBox4_Click() If CheckBox4 = False Then Columns(4).Hidden = True ElseIf CheckBox4 = True Then Columns(4).Hidden = False End If End Sub Private Sub CheckBox5_Click() If CheckBox5 = False Then Columns(5).Hidden = True ElseIf CheckBox5 = True Then Columns(5).Hidden = False End If End Sub Private Sub CheckBox6_Click() If CheckBox6 = False Then Columns(6).Hidden = True ElseIf CheckBox6 = True Then Columns(6).Hidden = False End If End Sub CheckBox.rar

شكرا أخي ياسر بعد محاولات عديدة وتتبع للخلل وجدت بغيتي أنا كنت أبحث عن كلمات وأرقام وكان الخطأ عند البحث بواسطة كلمة ، ولكن بعد حذف "cdb1 " من السطر حلت المشكلة وتم تعديل السطر الى If (.Cells(I, (Range("b1").Value))) = (Range("C1")) Then مرفق ملف لمن أراد الاستزادة Overtime Report Loop Through All Sheets YasserKhalil 1.rar وطلب أخير هل يمكن اختصار الكود من الأسطر والمتغيرات الغير ضرورية لملفي - ان وجدت - لسهولة التعديل بعد ذلك ؟؟

عند تعديل عامود البحث للعامود 4 فما فوق يعطيني خطأ أخي ياسر If CDbl(.Cells(I, 4)) = CDbl(Ws.Cells(1, "C")) Then

باختصار 1- كود البحث مبني على القيم الموجودة في أول عامود لو أردت تغيير عمود البحث فأين يمكنني التغيير ؟ 2- ما فائدة هذا الشرط ؟ If CDbl(.Cells(I, 1)) = CDbl(Ws.Cells(1, "C")) تم ارفاق الملف Overtime Report Loop Through All Sheets YasserKhalil 1.rar

هنا الكود ومرفق الملف Option Explicit 'Author : YasserKhalil 'Release : 25 - 08 - 2016 Sub Test() Dim Ws As Worksheet Dim Sh As Worksheet Dim I As Long Dim J As Long Dim Lr As Long Dim Last As Long Set Ws = Sheets("Sheet1") J = 3 Application.ScreenUpdating = False With Ws.Range("A3:H1000"): .ClearContents: .Borders.Value = 0: End With If IsEmpty(Ws.Range("C1")) Then MsgBox "Employee Number Not Existing", vbExclamation: Exit Sub For Each Sh In ThisWorkbook.Worksheets If Sh.Name <> Ws.Name Then With Sh Lr = .Cells(Rows.Count, 1).End(xlUp).Row For I = 2 To Lr If Not IsEmpty(.Cells(I, 1)) Then If CDbl(.Cells(I, 1)) = CDbl(Ws.Cells(1, "C")) Then Ws.Cells(J, 1) = Ws.Cells(J, 1).Row - 2 Ws.Cells(J, 2).Resize(1, 3).Value = Sh.Cells(I, 3).Resize(1, 3).Value Ws.Cells(J, 5).Value = Sh.Cells(I, 12).Value Ws.Cells(J, 6).Value = Sh.Cells(I, 10).Value Ws.Cells(J, 7).Formula = "=TIME(8,,)" Ws.Cells(J, 8).Formula = "=IF(AND(F" & J & "="""",G" & J & "=""""),"""",IF(F" & J & ">G" & J & ",(F" & J & "-G" & J & "),0))" J = J + 1 End If End If Next I End With End If Next Sh If J < 4 Then MsgBox "No Employee With That Number", 64: Exit Sub Last = IIf(Ws.Cells(Rows.Count, 1).End(xlUp).Row < 3, 2, Ws.Cells(Rows.Count, 1).End(xlUp).Row) With Ws.Range("A2:H" & Last): .Borders.Value = 1: End With Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub

شاكر ردك أخي أبو عبد الباري ولكن كما قلت تم الاستغناء عن ذلك ولكن لاثراء المعلومات هناك ملاحظتين 1- هناك أمر لم أجده في الكود وهو يجعل قيمة الخلية c1 تساوي اسم commandbutton 2- بطريقتك هذه أظن أنني بحاجة ألى كتابة الأمر لكل commandbutton على حدة والمطلوب هو كتابة الأمر مرة واحدة فقط للكل كما في كود التسمية

أعتذر على التأخير لظروف العمل تم الاستغناء عن الطلب الثاني نظرا لتغير طرأ على فكرة البرنامج وانعدام الحاجة لذلك الأمر شاكر جدا لكم إخواني الكرام وأعتذر مرة أخرى على التأخر في الرد

حاضر أخي ياسر لكن اعذرني الملف ليس معي الآن وللتوضيح أكثر الفكرة هي أني عندي 30 commandbutton كلهم لهم نفس الأمر وهو تسمية الخلية c1 باسم commandbutton +فلترة النطاق A$1:$C$38 بدون خلايا فارغة أنا أسأل هل فيه كود أستطيع به كتابة الأمر مرة واحدة لكل commandbutton ، أم لا بد من كتابة الأمر لكل commandbutton على حدة وإن شاء الله أرفع لكم الملف غدا

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

حاجة على السريع انظر المرفق ملف الرواتب1.rar

المرفق فاااااااااارغ

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

اخواني استفسارين 1- أريد معرفة كيف يمكن تسمية عدة commandbutton بالكود بناء على قيم خلايا ؟ يعني مثلا عندي عدد 30 commandbutton ، أريد تسميتهم بقيم الخلايا من a1:a30 2- كيف يمكن اختصار الكود التالي ؟ Private Sub CommandButton1_Click() Range("c1") = CommandButton1.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton2_Click() Range("c1") = CommandButton2.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton3_Click() Range("c1") = CommandButton3.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton4_Click() Range("c1") = CommandButton4.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton5_Click() Range("c1") = CommandButton5.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton6_Click() Range("c1") = CommandButton6.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton7_Click() Range("c1") = CommandButton7.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton8_Click() Range("c1") = CommandButton8.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton9_Click() Range("c1") = CommandButton9.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton10_Click() Range("c1") = CommandButton10.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton11_Click() Range("c1") = CommandButton11.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton12_Click() Range("c1") = CommandButton12.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton13_Click() Range("c1") = CommandButton1.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub Private Sub CommandButton13_Click() Range("c1") = CommandButton1.Caption Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1 Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>" End Sub

قم بارفاق ملف

انظر المرفق وأخبرني بالنتيجة فلتر يوزر فورم مع التعديل.rar

مبارك الترقية أستااذي ومعلمي @سليم حاصبيا وفعلا أنت تستحق الترقية عن جدااااارة

طيب تحديدا ماذا تريد ؟ 1- تقرير شامل لكل موظف على حدة ؟ أم 2- تقرير كل شهر على حدة ؟ أم ماذا ؟ حدد ما تريده بالضبط وإن شاء الله نحاول معك

أخي محمد انظر المرفق تم عمل الآتي ترحيل الدخول والخروج اى شيت منفصل يمكنك استنباط ما تريد من تلك الفكرة يمكنك عمل تقرير لكل موظف منفرد أو تجميع كل شهر على حده حاول أنت واذا أوقفك شئ أخبرنا calculation - Mar. 2016 salim.rar

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

انظر المرفق حماية صفحة التقرير باسورد فارغ calculation - Mar. 2016 salim.rar

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

&&المعادلة الموجودة في التقرير غير المكتوبة في الرد فكرة العمل أن دالة vlookup تتقوم بجلب قيمة واحدة فقط لكل متغير فتم التغلب على المكشلة بواسطة المعادلة الموجودة في العمود a في شيت print ثم في التقرير الباسورد 12345 فك الحماية وانظر المعادلة &&النقطة الأخرى الذي فهمته أنك تريد عمل شيت print بالمعادلات كما هو موجود بدلا من أن تنقل اسم اسم أنا حاليا مشغول شوية بس أوعدك إن شاء الله أحاول أو يسبقني أحد الأخوة

تم فك الدمج لكي يعمل الكود تفضل المرفق فلترة الاسماء بظهور ثلاثة صفوف(1).rar

تفضل المرفق وأسألك الدعاء calculation - Mar. 2016 salim(1).rar

هل من مساعدة إخواني ؟