نجوم المشاركات

الاخ احمد بن ابراهيم انظر المرفقات Omar_2.rar

الاخ احمد بن ابراهيم شكرا لك اخي الدعاء لا الشكر الاخ ياسر خليل أبو البراء شكر لك اخي ليقضي الله أمرا كان مفعولا الاخ سعد عابد شكر لك اخي سعد عابد مازلنا نتعلم

صجيج يعطي نفس النتيجة لكن الكود قصير جداً ولا حاجة لليست بوكس ولا الى اي اجراءات اخرى كما يمكنك استعمال الكود forrmat_me , وذلك لاخفاء الكتابة في الخلايا المكررة (لانك استعملت اللون الابيض لهذا الشيء) مما يجغل اخلية مرئية في حال تحديدها اليك الكود Sub format_me() With Sheets("ورقة 1") lr = .Cells(Rows.Count, 1).End(xlUp).Row For i = 11 To lr - 3 t = i Mod (3) If t <> 0 Then Range("a" & i).Resize(1, 5).NumberFormat = ";;;" End If Next End With End Sub

بسم الله الرحمن الرحيم Formula To VBA ضع الماوس على الخلية التي يوجد فيها معادلة معينة وإضغط على بسم الله ستظهر لديك المعادلة محولة و جاهزة للنسخ , قم بنسخها ثم قم بوضعها داخل كود أخونا الكريم عبد الله باقشير جزاه الله خيرا . الطريقة و الكود في المرفقات لكم مني أطيب التحيات محول المعادلات السريع.rar

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

السلام عليكم ورحمة الله وبركاته إخواني الكرام وأحبابي في الله تلقيت دعوة بالتسجيل في موقع للحصول على كورس مجاني لمدة ساعة واحدة لتعلم أساسيات الـ VBA الكورس سيكون اليوم 25 أغسطس 2016 الساعة التاسعة مساءً بتوقيت الاسكندرية .. بعد التسجيل يمكنك معرفة التوقيت المناسب لمنطقتك رابط التسجيل من هنا كل ما عليك هو أن تسجل إيميلك واسمك وسيصلك رسالة على الإيميل في الحال بعد وصول الإيميل ستدخل على الرابط التالي في الوقت المحدد وتدخل بياناتك لدخول قاعة الدراسة من هنا سيطلب منك إدخال كود مكون من 9 أرقام (سيصلك في الإيميل) + الايميل الخاص بك .. (احتفظ بالكود المكون من 9 أرقام ولا تحذف الرسالة) لا تنسى الموعد الساعة التاسعة مساءاً اليوم 25 أغسطس (تدريب مباشر أونلاين) أرجو أن يكون الكورس مفيد لكم إن شاء الله تقبلوا وافر تقديري واحترامي

تفضل انقر F2 ولاحظ يجب ان يكون التركيز واقع على النموذج Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF2 Then DoCmd.OpenForm "A1", acNormal End If End Sub db.rar

جرب المرفق Book8.rar

وعليكم السلام أخي الكريم محمد إليك الكود التالي عله يفي بالغرض إن شاء الله '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 تقبل تحياتي Overtime Report Loop Through All Sheets YasserKhalil.rar

اخى عمر الحسينى والله انت مدرسه كما قال اخى ياسر وشروحاتك بطريقه مميزه ننتظر المزيد جزاك الله خيرا

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

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

جرب هذا المرفق الإدارة1.rar

جرب هذا الملف و حاول تغيير اي بيانات في اي صفحة وانظر الى الصفحة "مراقبة" الادارة salim.rar

الاخ احمد بن ابراهيم انظر المرفقات Omar_1.rar

أخي الكريم محمد .. أنا لم أبتعد عن الطلب بشكل متعمد إلا أنني أحاول أن أيسر لك الأمر ..فأخبرتك أن ورقة العمل Print (على ما أعتقد أنها ورقة عمل مساعدة لك فقط حتى يتسنى لك استخراج التقرير بشكل منضبط) .. عموماً تم التعديل على الخلية C1 وجعلها تقبل بإدخال أرقام الموظفين فقط وهذا أمر يسير حيث تم تغيير المعادلة في العمود الأول في ورقة العمل Print وتغيير تنسيق الخلية C1 في ورقة التقرير .. أما الطلب الثاني هو مربط الفرس وهذا ما تعثرت فيه في مشاركتي السابقة التي أرفقت لك فيها ملف ... حيث أن المشكلة أن هناك موظفين لها ساعة دخول وليس لها ساعة خروج والعكس صحيح .. أي أن البيانات غير منضبطة ومن ثم كيف سيكون المنطق في عملية استخراج البيانات ... وضح الخطوات التي تقوم بها بشكل يدوي لعلنا نفيدك Report t.rar

أستاذي العزيز / ياسر خليل أولا أشكر حضرتك على الإهتمام الموضوع أنا هارفق لحضرتك شيت كنت بدأت بيه مع الأستاذ أبو حنف وتوصلنا لنتيجه ممتازه إلا إن الموضوع متوقف على حاجه واحده بس ÷اشرحها لحضرتك التقرير بينطبع من الورقة All فقط والأستاذ أبو حنف أضاف عليه معادلات للعمود A-b-c-d- انا بجمع كل البيانات الموجودة في الورقة Print بس للأسف بجمعها موظف موظف وتاريخ تاريخ ودا بياخد وقت كبير جدا انا كل اللي انا محتاجه نفس التقرير الموجود في الورقة taqreer بس البيانات تكون من الورقة All او يكون في هناك آليه ان احنا نجيب البيانات للورقة Print بس عن طريق معادلات يعني كل اللى انا محتاجه اني اجيب التقرير الموجود في الورقة taqreer من الورقة All أو الورقة Print بس ميكنش الشغل يدوي وهذا هو المرفق calculation - Mar. 2016 salim.rar وبعدين انا مش عاوز ابعد حضرتك بعيد عن الموضوع التاريخ هايكون مرجعة للعمود G في حالة C/In أو C/Out اما التاريخ اللى انا محتاجة في الخلية C1 فهو التنسيق العادي يعني مجرد اني اكتب التاريخ المعادلات تعرف مين اللي عمل C/In أو C/Out في اليوم ده ولو ممكن يبقي الفلتر عن طريق رقم الموظف يعني يكون تاريخ ورقم الموظف لو احتاجته وتقبل تحياتي

السلام عليكم ورحمة الله وبركاته أخي أحمد: عندي اقتراح استخدمه في برامجي وهو تحويل علامة 50 الى رقم 1 واقل من ذلك 0 w1=IIf([A1]<50,1,0) طبق السابق على جميع الحقول a1 a2 a3 a4 الى اخره بعد ذلك نقوم بجمع الحقول التي قمنا بتطبيق الكود عليها w1+w2+w3+w4 مع استخدام Nz طبعا وليكن اسم حقل الجمع مثلا: AllMrks الآن نقوم بوضع شرط النجاح او الرسوب IIf([AllMrks]=4,"راسب","ناجح") جرب ووافني بملاحظاتك\ :: تحياتي

الاخ أبو العقاب انظر المرفقات Omar_1.rar

بعد اذن اخي عمر اليك هذا الحل بالمعادلات( رغم ان الخلايا المدمجة من الد اعداء الكود والمعادلة) القائمة المنسدلة مطاطة (تستحيب لاي تعديل في البيانات) salim.rar

اخوتي .. طلب الاخ الزميل OLIVER916 التفقيط من داخل فاتوره وبالدرهم .. فضلت ان يكون ردي في موضوع جديد لتعم الفائدة ، إن كانت فيها فائدة ?? hassan.rar

الأخ الحبيب محبوب تعبت والله ..بقالي ساعتين عشان أعمل الكود الملعبك ده بس الحمد لله بفضل الله تم المطلوب .. افتح ملف "الأقساط الشهرية 2015" ستجد الكود بداخله .. في ورقة الفهرس يوجد زر امر انقر عليه لتنفيذ الكود .. Sub YasserKhalil() Dim WBK As Workbook Dim SH As Worksheet, WS As Worksheet, Cell As Range Application.ScreenUpdating = False Application.DisplayAlerts = False Set WBK = Workbooks.Open(ThisWorkbook.Path & "\حسابات العملاء 1.xlsx") For Each SH In ThisWorkbook.Sheets If SH.Name <> "الفهرس" Then SH.Range("C6:F99,H6:I99").ClearContents For Each WS In WBK.Sheets If WS.Name <> "الفهرس الرئيسى" Then With WS If IsEmpty(.Range("A6")) Then GoTo 1 For Each Cell In .Range("A6:A" & .Cells(Rows.Count, 1).End(xlUp).Row) If Month(Cell.Value) = MonthNumber(SH.Name) Then SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2) SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3) SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value End If Next Cell 1 End With End If Next WS End If Next SH WBK.Close SaveChanges:=False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function MonthNumber(MonthName As Variant) As Variant Select Case MonthName Case "": MonthNumber = "" Case "يناير": MonthNumber = 1 Case "فبراير": MonthNumber = 2 Case "مارس": MonthNumber = 3 Case "ابريل": MonthNumber = 4 Case "مايو": MonthNumber = 5 Case "يونيو": MonthNumber = 6 Case "يوليو": MonthNumber = 7 Case "اغسطس": MonthNumber = 8 Case "سبتمبر": MonthNumber = 9 Case "اكتوبر": MonthNumber = 10 Case "نوفمبر": MonthNumber = 11 Case "ديسمبر": MonthNumber = 12 End Select End Function تقبل تحياتي ولا تنسى أن تحدد المشاركة إذا أعجتك الإجابة كأفضل إجابة (ساعتين مني قصاد ثانيتين منك .. أظن كدا عدل والحمد لله) Three Loops In Two Excel Files By YasserKhalil.rar