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

أخي الكريم راجع الرابط التالي فيه حل لمشكلتك إن شاء الله من هنا

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

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

احد الطرق علها تفى بالغرض......المرفق 1_2.rar

عدد ساعات العمل 8:10 مضبوط ؟؟ كيف تقوم بحساب فرق التوقيت جرب المعادلة التالية ستعطيك نفس النتيجة =I6-J6+(J6>I6)

تفضل أخي الغالي أبو يوسف الملف التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("D4:F4")) Is Nothing Then Application.EnableEvents = False If Target.Address = "$D$4" Or Target.Address = "$E$4" Then _ Cells(4, 6) = (Cells(4, 5) * Cells(4, 4) / 100) * 100 If Target.Address = "$D$4" Or Target.Address = "$F$4" Then _ Cells(4, 5) = (Cells(4, 6) / Cells(4, 4) * 100) / 100 Application.EnableEvents = True End If End Sub Circular Reference YasserKhalil.rar

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

اخى الفاضل وبعد اذن استازى ياسر يمكنك استخدام الكود التالى فهو اكثر اختصارا Sub khaled() Application.ScreenUpdating = False Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select Selection.EntireRow.Insert Range("D" & Selection.Row).FillDown Application.ScreenUpdating = True End Sub

ربنا يخليك يا أخي الغالي إبراهيم على المجاملة الرقيقة دي اللي عندي بعض من عندكم .. بس أيوووووووه دي اسكندراني !! إنت من إسكندرية ولا ايه .. تقبل تحياتي

راجع المشاركة مرة أخرى ..كنت قد أضفت أسطر لتجنب الخطأ قبل أن تسأل

جرب هذا الرابط من هنا

اخى الفاضل لقد قمت باضافة المشاركة السابقة دون ان انتبة الى مشاركتك التى فيها التوضيح او انها لم تظهر عندى الا بعد اعادة تحميل صفحة الموضوع عموماً استازى ابو البراء قام بالمطلوب فقط قم بوضع تلك الجملة فى بداية كود استاذ ياسر حتى لا تظهر معك اخطاء حال خلو السطر الاخير من البيانات On Error Resume Next استازى ابو البراء جعل الله جهودك فى ميزان حسناتك ..... حقاً مبدع خالص احترامى

جرب هذا التعديل .. حاول أن تبتعد عن دمج الخلايا لأنه يسبب مشاكل مع الأكواد Sub khaled() Application.ScreenUpdating = False Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select Rows(Selection.Row - 1).Copy Rows(Selection.Row).Insert Shift:=xlDown On Error Resume Next Rows(Selection.Row).SpecialCells(xlConstants).ClearContents On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

الأداة قمت بتنصيبها على أوفيس 2007 وتعمل بشكل جيد ، كما قمت بتنصيبها على أوفيس 2013 بروفيسشنال بلس يعني نسختك وتعمل بشكل جيد .. حاول أن تقوم بإصلاح نسخة الأوفيس قد تكون المشكلة فيها ... أو ابحث مرة أخرى في النافذة الخاصة بالـ additional controls لعلك لم تراها

جزاك الله كل خير بارك الله فيك اخى ياسر ويسر الله امرك كما تيسر علينا

جرب الكود التالي .. ويراعى فيما بعد وضع بعض البيانات لتجربة الكود عليها إذ أن البيانات الموجود عند تنفيذ الكود لن يكون هناك نتائج حيث أنه لا توجد شروط مطابقة .. قم بتجربة الكود وغير في بعض الأرقام في أيام الأجازات ثم نفذ الكود .. يمكنك الاستغناء عن العمود الثالث الذي تكتب فيه عدد أيام الشهر .. ويمكن الاستغناء عن المعادلة في الخلية D3 والتي تحدد لك عدد أيام الشهر Sub Searches() Dim WS As Worksheet, str As String Dim I As Long Dim Found As Range Set WS = Sheets("تقرير خصم الراتب والعموله") str = WS.Range("B3").Value lRow = 7 Application.ScreenUpdating = False WS.Range("A7:C1000").ClearContents For I = 6 To Sheets.Count Set Found = Sheets(I).Columns("H:H").Find(str) If Not Found Is Nothing Then 'الشروط المطلوبة If (Found.Offset(0, -1) > 16 And NumberOfDays(str) = 31) Or _ (Found.Offset(0, -1) > 15 And NumberOfDays(str) = 30) Or _ (Found.Offset(0, -1) > 14 And NumberOfDays(str) = 29) Then WS.Cells(lRow, 1) = Sheets(I).Range("B3") 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 Function NumberOfDays(str As String) If str = "" Then NumberOfDays = "" ElseIf str = "يناير" Or str = "مارس" Or str = "مايو" Or str = "يوليو" Or str = "أغسطس" Or str = "أكتوبر" Or str = "ديسمبر" Then NumberOfDays = 31 ElseIf str = "أبريل" Or str = "يونيو" Or str = "سبتمبر" Or str = "نوفمبر" Then NumberOfDays = 30 ElseIf str = "فبراير" Then NumberOfDays = 29 End If End Function

شكرا لك وبارك لك وفيك .. على ما قدمت من نفع لي وللأخوان في المنتدى فلك جزيل الشكر والعرفان

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

شكرا جزيلاً لك اخى عبد العزيز خالص حبى واحترامى

السلام عليكم و رحمة الله و بركاته عمل في القمّة .. بارك الله فيك و لك .. و زادها بميزان حسناتك تحياتي

جرب وضع الكود التالي بحدث عند الخطأ للنموذج If DataErr = 3022 Then MsgBox "الاسم موجودٌ مسبقاً" Response = acDataErrContinue End If

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

سهل الله لك صعب ويسر لك عسير ألف شكر لك ياغالي

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

الأمر بسيط استخدم السطر التالي للإخفاء ws.Range("AZ" & lr).EntireRow.Hidden = True وغير كلمة True إلى False للإظهار انتهى

جزاك الله كل خير اخى ياسر وبارك الله لك فى اهلك ومالك ورزقكك راحة البال

هو فيه حل لمشكلة المرجع الدائري .. من خلال خصائص الإكسيل ..Excel Options ثم اختر Formulas ثم علم علامة صح على المربع بجانب الخيار المسمى Enable Iteratve calculation ولكن ما هو شكل النتائج المتوقعة مع المجموع 100 على سبيل المثال .. لأن الناتج في هذه الحالة وبالاحتفاظ بالمعادلات يساوي 0 ... أو جرب الكود التالي في حدث ورقة العمل .اعمل كليك يمين على اسم ورقة العمل ثم View code والصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub Application.EnableEvents = False If Target.Address = "$E$4" Then Target.Offset(, 1) = Target / Target.Offset(, -1) If Target.Address = "$F$4" Then Target.Offset(, -1) = Target / Target.Offset(, -2) Application.EnableEvents = True End S

السلام عليكم و رحمة الله و بركاته الأب العزيز محمد حسن المحمد ثقتنا بالله تجعلنا نقول بعد بسم الله الرحمن الرحيم : "إنّ مع العسر يسرا" صدق الله العظيم خالص تقديري واحتراماتي

خلي السطر بالشكل ده عشان تجمع بين الشرطين If (Found.Offset(0, -1) > 4 And Sheets(H).Range("D5").Value > 50) Or (Found.Offset(0, -1) > 3 And Sheets(H).Range("D5").Value < 50) Then

لن أطيل في الرد وسأوجز في كلمات بسيطة .. (لعله خير) (وعسى أن تكرهوا شيئاً وهو خير لكم ..) (ضاااااااااااااااقت فلما استحكمت حلقاتها فرجت .. وكنت أظنها حتماً ستفرج)

وعليكم السلام ورحمة الله وبركاته أخي الحبيب أبو يوسف ما هي المعادلات المستخدمة ؟يرجى إدراج بعض النتائج المتوقعة ..

أخي الحبيب أبو يوسف يؤسفني توقف القطار فأنا أحب دائماً أن أرى قطارك مسرعاً .. ولكن لي عتاب عليك لما تعتمد على غيرك في تحريك عجلات القطار ..لما لا تبادر أنت وتحرك العجلات وعندها ستجد أنك ستقوم بسحب الجميع مع هذه الحركة كيف ستحركه ؟ ابدأ بتناول التفاصيل الصغيرة ..قم بشرح ما توصلت إليه (يعني كأنك بتفكر بصوت عالي) وإن توقفت في جزئية سألت عنها وحاولت فيها ..هكذا أتعلم ! قد يبدو الأمر صعباً ولكنه لن يكون صعباً على الإطلاق إذا ما تكررت المحاولات ووجد الامل بشكل مستمر ... في انتظار دفع عجلات القطار ليصل إلى مبتغاه ونحن معك بما أوتينا على قدر ما نعلم .. ولن نبخل بمعلومة أو بوقت تقبل وافر تقديري واحترامي

اخى الفاضل جرب المرفق Book1_4.rar

وعليكم السلام أخوي الكريمين محمد ورمهان :-) فهمي للموضوع هو: - لديك مجلدات لكل كتاب أو وارد ، والكتاب الصادر أو الوارد قد يحتوي على مجموعة ملفات. س: ما إسم هذه المجلدات؟ أين توجد في الكمبيوتر؟ هل إسم المجلد له علاقة باي من حقول السجل؟ - تريد ان تفرز اسم وصيغة كل ملف موجود في المجلد الخاص للكتاب ، وهذه المعلومة تريدها في النموذج الفرعي. س: مثل ما قال الاخ رمهان ، مافي داعي لحفظ هذه الأسماء في الجدول. وفي احد مشاريعي ، طبقت طريقة قراءة محتوي المجلد في Listbox ، و عندما تريد فتح الملف ، تنقر مرتين على إسم الملف ، فيفتحه مباشرة من المجلد. هل ممكن استعمال هذه الطريقة ، أو أنك تريد الأسماء في الجدول لأنك تريد إضافة ملاحظات لكل ملف؟ س: شرحت لك أعلاه طريقة فتح الملف ، سواء بطريقتي أو بطريقتك في النموذج الفرعي. فلماذا تريد أن تحفظ الملف داخل قاعدة البيانات؟ حفظ الملفات داخل قاعدة البيانات غلط ، إلا في حدود جدا ضيقة ، وإلا فسيكبر حجم قاعدة بياناتك بطريقة مهولة ، وقد تصل إلى مرحلة العطب أو عدم إمكانية إضافة سجلات بها ، انا رأيت مثل هذه البرنامج :-( جعفر

حيا الله الاخوين محمد و جعفر انا اشوف اذا كان فقط استعراض الملفات ان تتم خلال مربع قائمة وليس نموذج فرعي ! ومربع القائمة ليس يستند على جدول بل تعبئتها لحظيا عند تخزين المجلد في الاعلى ! ولكن لاحظت ان هناك حقل نوت بجانب كل ملف ! فمعناته هناك ملاحظات لكل ملف ! فاذا كان لابد منه ماينفعشي السيناريو السابق ولا بد من الاكمال والادراج في النموذج الفرعي ! وهناك استفسارين: 1. هل ممكن اختصار مسار المجلد كامل في حقل واحد وفي النموذج الرئيسي وهنا سيحتوي المسار مسار المجلد واسمه بدلا من فصل المسار والاسم 2. هل ممكن كذلك الاكتفاء في النموذج الفرعي بمسار الملف كاملا محتويا على امتداده ! ام لابد من الفصل ! تحياتي وارجو استمرار الاستاذ جعفر بالمشاركة لافادة اكثر

تفضل اخى الكريم المطلوب بالمرفق العطارتمسنا_2015_07_21_2_2.zip لا تنسى ان تحدد الموضوع كمجاب

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

أعتقد أنه لا توجد امكانية في الأكسس لاعتماد نظامي تقويم في نفس الوقت والحل في ذلك يمكنك اختيار نوع التقويم في بداية تسجيل كل تاريخ ولا تقلق من تحويل التاريخ المكتوب بالميلادي إلى الهجري أو العكس باستخدام الأمر التالي Private Sub Text69_GotFocus() Application.SetOption "use hijri calendar", True End Sub Private Sub Text71_GotFocus() Application.SetOption "use hijri calendar", False End Sub في حدث عند امتلاك التركيز

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

قم بالإطلاع على المرفق التالي لعله يكون المطلوب Sub RunTest() Dim WS As Worksheet, SH As Worksheet Dim LR_WS As Long, LR_SH As Long, Rng As Range Set SH = Sheets("Collect") Application.ScreenUpdating = False Application.DisplayAlerts = False SH.Range("A2:D1000").ClearContents For Each WS In ThisWorkbook.Sheets If WS.Name <> "Collect" Then LR_SH = SH.Cells(Rows.Count, 1).End(xlUp).Row + 1 With WS LR_WS = .Cells(Rows.Count, 1).End(xlUp).Row Set Rng = .Range("A2:D" & LR_WS) Sheets.Add After:=Sheets(Sheets.Count) Rng.Copy ActiveSheet.Range("A2") End With With ActiveSheet.Range("E2:E" & LR_WS) .Formula = "=SUMPRODUCT(($A$2:$A$" & LR_WS & "=A2)*($B$2:$B$" & LR_WS & "=B2)*($C$2:$C$" & LR_WS & "))": .Value = .Value .Offset(0, -2).Value = .Value End With With ActiveSheet .Range("A2:D" & LR_WS).RemoveDuplicates Columns:=VBA.Array(1, 2, 3), Header:=xlNo .Range("A2:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy: SH.Range("A" & LR_SH).PasteSpecial xlPasteValues .Delete End With End If Next WS Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Remove Duplicates For Summary Report YasserKhalil.rar

اتقدم بخالص الشكر والتقدير للقائمين على هذا المنتدى والاعضاء والزائرين مع تحيات amr atef eid عذرا لعدم المشاركة المستمرة لضيق الوقت ____________________1.rar

أخي العزيز AMR عمل رائع ومجهود متمتيز تستحق عليه كل شكر وتقدير . تقبل تحياتي . أبو عبدالله