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

السلام عليكم ورحمة الله وبركاته 💐 أخي الكريم @lionheart أعتقد أن الأخ @Rahem قد كرر الموضوع بتاريخ معين وأعتقد أن ذلك بغير إرادة منه وذلك قد يكون بسبب ضعف النت وهنا يبدأ دور الإخوة المسؤولين - فضلاً لا أمراً- في حذف الموضوع المكرر قبل أن تكون هناك مشاركات لأحدهما. تقبلوا تحياتي العطرة والسلام عليكم ورحمة الله وبركاته 🏵️

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

Option Explicit Const iCol As Integer = 7 Sub Test() Dim e, rng As Range, lr As Long Const sOutput As String = "Output" Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next: Sheets(sOutput).Delete: On Error GoTo 0 Application.DisplayAlerts = True Sheets(1).Copy , Sheets(Sheets.Count) Sheets(Sheets.Count).Name = sOutput With Sheets(sOutput) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").CurrentRegion.Borders.Value = 1 .Columns("A:F").AutoFit With .Columns("G") .ColumnWidth = 80 .Rows("1:" & lr).HorizontalAlignment = xlRight End With .Range("A1").Resize(, iCol).Interior.Color = RGB(255, 217, 102) With .Sort .SortFields.Clear For Each e In Array("A1", "B1", "C1", "D1", "E1") .SortFields.Add Key:=Range(e), Order:=xlAscending Next e .SetRange Range("A1:A" & lr).Resize(, iCol) .Header = xlYes .Apply End With Set rng = .Range("A2:A" & lr) MergeSimilarCells rng End With Application.ScreenUpdating = True End Sub Sub MergeSimilarCells(workRng As Range) Dim rng As Range, nRng As Range, xRows As Integer, i As Integer, j As Integer, ii As Integer, cnt As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = workRng.Rows.Count For Each rng In workRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If rng.Cells(i, 1).Value <> rng.Cells(j, 1).Value Then Exit For Next j Set nRng = workRng.Parent.Range(rng.Cells(i, 1), rng.Cells(j - 1, 1)) If nRng.Rows.Count > 1 Then For ii = 0 To 4 nRng.Offset(, ii).Resize(nRng.Rows.Count).Merge Next ii End If nRng.Resize(, iCol).BorderAround Weight:=xlThick nRng.Offset(, iCol - 1).Resize(nRng.Rows.Count).WrapText = True cnt = cnt + 1 If cnt Mod 2 = 0 Then nRng.Resize(, iCol).Interior.Color = RGB(255, 230, 152) Else nRng.Resize(, iCol).Interior.Color = RGB(255, 242, 204) End If i = j - 1 Next i Next rng Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

Sub Test() Dim ws As Worksheet, cl As Range, rng As Range, v As String Set ws = Sheets("Sheet1") With CreateObject("Scripting.Dictionary") For Each cl In ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)) v = Join(Application.Index(cl.Resize(, 7).Value, 1, Array(1, 2, 3, 4, 5)), "|") If Not .Exists(v) Then .Add v, cl Else If rng Is Nothing Then Set rng = cl Else Set rng = Union(rng, cl) End If Next cl End With If Not rng Is Nothing Then rng.EntireRow.Delete End Sub

السلام عليكم 🙂 نعمل البرنامج ، ثم نقسمه الى قسمين ، FE الواجهة و BE الجداول ، ولما نعطيه للمستخدم ، نربط الجداول بمسار خاص به ، ويعمل البرنامج. ولما المستخدم يحتاج الى تعديل/اضافات ، ويرسل لنا نسخته بالايميل (انا ممكن اكون مسافر وبعيد عن نسختي) ، فيجب علينا ان نغير مسار الجداول ليتناسب مع مجلدات الكمبيوتر عندنا ، ولما ننتهي من التعديل ، نرسله بالايميل ، وهناك يجب على المستخدم ان يغير المسار الى ذلك الذي به BE الاصل 🙂 المشكلة انه: 1. بعض الاوقات نكون قد وضعنا الـ BE في مكان لا يجب ان يعرفه المستخدم ، فلا نريد تدخل منه لهذا التغيير ، 2. بعض الاوقات المستخدم لا يعرف مكان الـ BE اصلا ، 3. وبعض الاوقات ، المستخدم لا يكون فني ليعرف كيف يختار مكان الـ BE 🙂 صادفتني هذه المشكلة مراراً ، ومرة دفعت الثمن غالي لما ربطوه بالـ BE الغلط ، ربطوه بنسخة الـ Backup بدل عن النسخة الاصل 😁 الى ان اهتديت الى هذه الطريقة 🙂 الفكرة هي عبارة عن اضافة جدول tbl_ReLink_To_Original في الـ FE فيه سجلين ، سجل يحتوي على مسار BE المستخدم ، وسجل يحتوي على مسار BE المبرمج ، وبدل هذا الجدول ، ممكن ان نضع ملف نص txt في مجلد FE ، ونكتب فيهم السجلين ، ثم نقرأهم ، ولكن الجداول في الـ FE تناسبني اكثر ، فإستعملتها 🙂 1. لمعرفة مسار BE المستخدم: . . ثم ننسخه من (1) جدول MSysObjects الى السجل الاول (Seq = 1) في جدولنا (2) tbl_ReLink_To_Original . ثم في السجل الثاني (Seq = 2) ، نكتب مسار الـ BE حسب مجلدات الكمبيوتر عندنا (3) . طريقة العمل: نعمل ماكرو Macro باسم Autoexec ، والذي يقوم الاكسس بفتحه وتنفيذ اوامره اول ما يفتح البرنامج ، 1. نقوم بتشغيل الكود الذي سيربط الـ BE الى المسار الصحيح للمستخدم (اما المبرمج فلا يسنخدم هذا الماكرو ، وانما يدخل في البرنامج بمسك مفتاح الشفت) ، 2. اذا لم يحصل البرنامج على المسار الصحيح ، فيجب ان نخبره ان يعطينا نافذة نختار منها المسار الصحيح ، وهناك عدة طرق ، واخترت طريقتي هنا ، 3.4.5.7.8 هذه لإخفاء جميع كائنات البرنامج من جداول واستعلامات ونماذج وماكرو وتقارير ووحدات نمطية ، وتوسيع البرنامج لحجم الشاشة (فلا نحتاج ان نجعل النموذج منبثق ، والذي به الكثير من المشاكل) ، 5. فتح النموذج الاول من البرنامج ، . هذه هي الوحدة النمطية التي تقوم بالعمل (1) اعلاه : Public Function f_ReLink_To_Original(Optional Seq As Integer = 1) 'On Error GoTo err_f_ReLink_To_Original On Error GoTo Exit_f_ReLink_To_Original ' ' The client have his own path to the linked BE tables, ' yet for Development when we want to do change and modifications on the FE, ' we want to link this FE to our local BE tables, for testing, ' and we are done, we will send this FE back to the client, which will have our BE path!! ' ' Although the FE have a code on startup, which will prompt for the new BE path, but not all clients know how to use it!! ' So I added a table tbl_ReLink_To_Original to the FE, and the path to the client BE path, as Seq = 1 , ' and for the Developer BE, the Seq is 2 or other numbers. ' ' for the Development BE path, we call this Function, for the immediate window: ' ?f_ReLink_To_Original(2) ' ' or from a normal Event: ' Call Call f_ReLink_To_Original(2) ' ' and enter the DB with Shift key, ' ' and when the FE goes to the client, this Function will call Seq = 1 by default, thus returning their correct Path. ' ' ' by jjafferr ' ' v1. 24-Feb-2020 ' Dim db As dao.Database Dim tdf As dao.TableDef Dim ConnectionString As String, Linked_Connection As String Set db = CurrentDb 'which BackEnd the user selected ConnectionString = DLookup("[DB_Path]", "tbl_ReLink_To_Original", "[Seq]=" & Seq) 'the existing BackEnd Linked_Connection = DLookup("[Database]", "MSysObjects", "[flags] = 2097152") 'if the existing BackEnd = User Selected, then No need to connect again, just exit If ConnectionString = Linked_Connection Then GoTo Exit_f_ReLink_To_Original For Each tdf In db.TableDefs ' Only make a change if the table is a linked table If Len(tdf.Connect) Then tdf.Connect = ";DATABASE=" & ConnectionString tdf.RefreshLink End If Next Exit_f_ReLink_To_Original: Exit Function err_f_ReLink_To_Original: If Err.Number = 3170 Then 'MsgBox "رجاء التاكد من مسار القاعدة الموجوده في الجدول" & vbCrLf & "tbl_ReLink_To_Original" 'Resume Next Resume Exit_f_ReLink_To_Original Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_f_ReLink_To_Original End If End Function . اما للمبرمج ، فيجب عليه ان يدخل الكود ويكتب (لاحظوا اننا استخدمنا الرقم Seq = 2 ، ليشير الى السجل الثاني في الجدول ، المشير الى مسار الـ BE حسب مجلدات الكمبيوتر عندنا (3) : من نافذة الكود السفلى: immediate ?f_ReLink_To_Original(2) او من اي حدث Call f_ReLink_To_Original(2) . واذا اردت الاستفادة من هذه الطريقة لبرامجك ، فيجب عليك استيراد هذه الكائنات الى برنامجك (مع الاخذ في الاعتبار تغيير اسم النموذج في ماكرو autoexec ) : جعفر Relink Tables.zip

جربى هذا الفيديو

السلام عليكم ورحمة الله المصنف1.rar

اذا تشوف صورة الاكسل في مشاركتي اعلاه ، تشوف انها جمعت مبالغ السجلات الثلاثة في سجل واحد. هل هذا اللي تريده؟

وعليكم السلام 🙂 اللي فهمته هو ، اذا عندك نفس الاسم مكرر اكثر من مرة ، مثل ازهار مثلا : . ففي الاكسل تريد قيمها مجموعة هكذا : . هل هذا قصدك ؟ جعفر

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

تفضل جرب هذا الملف رسائل واتس كصورة للنطاق1.xlsm

الكود موجود في المنتدى وانا عرضته كاملا مع شروحات الأصل في اكثر من مشاركة تخص ربط الجداول ولكني هذبته لغرضي هذا الخاص هذا هو الكود: Public Function AutoLinks(ByVal strDBPassword As String) As Boolean On Error GoTo AutoLinksErr Dim tdf As TableDef Dim strNewMDB As String For Each tdf In CurrentDb.TableDefs If UCase(Left(tdf.name, 6)) <> "COMPAS" Then If Len(tdf.Connect) > 0 And tdf.Fields.Count = 0 Then strNewMDB = "c:\bader\BData.db" If (IsNull(strDBPassword) = True) Or (strDBPassword = "") Then tdf.Connect = ";DATABASE=" & strNewMDB Else tdf.Connect = ";DATABASE=" & strNewMDB & ";PWD=" & strDBPassword End If tdf.RefreshLink End If End If Next tdf AutoLinks = True ' AutoLinksDone: Exit Function AutoLinksErr: MsgBox "لا يوجد قاعدة بيانات فضلا اتصل بالدعم الفني" 'MsgBox "Error #" & err.Number & ": " & err.Description, vbCritical Resume AutoLinksDone End Function ويتم مناداته في نموذج البداية على هذا النحو : If AutoLinks("") = False Then Call Application.Quit End If وهذا مرفق صغير عبارة عن مجلد .. تم اعداده على ان يتم وضع المجلد على قرص C وللتجربة يمكن اخذ نسخة من القاعدة الخلفية BDAta.db ولصقها في اي مكان آخر وتغيير اللاحقة الى mdb واجراء التجربة bader.rar

بارك الله فيك اخى العزيز ..تم حل المسأله بفضلكم وجهودكم ,,,, ربنا يبارك فى حياتك اخى الغالى

شكرا على اهتمامك

اخوي ابوخليل ، ويقول المثل قديم البريسم ولا جديد الصوف 🙂 خلينا نشوف الكود لوسمحت علشان اطبق واجرب 🙂 جعفر

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

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

المطلوب حساب المبالغ التي تم دفعها في الأشهر مثلا حساب الدفعة الأولى والدفعة الثانية في شهر دفعات الاشهر.xlsx

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

السلام عليكم شكرا على اهتمامك بس للاسف كنت عاوز اجمع خليه الوزن الصافى برقم بوليصه 101 والوزن الصافى لبوليصه 102

لله درك باش مهندس .. @jjafferr 😊🌺 كنت حاس يقينا أنه لديك إضافات وتحديثات للموضوع 👍😉 ما شاء الله عليك ، ومن وحي التجارب والحاجة تولد عجائب الأمور ... 😊 ولي إضافات من تجاربي على نفس هذا الموضوع ومحاولة لتطبيق الأفكار التي أثارها موضوعك في راسي قريبا إن شاء الله 😁 سأحاول تبسيط الأمور أكثر باستخدام نوافذ صديقة للمستخدم إن شاء الله 🤗 مستعينا بالله ثم خلاصة ما طورته أنت في هذا الشأن ..

اكيد يوجد حل وافضل من الأول يمكنك الآن ادخال مئات التحويلات في اليوم الواحد وللدائرة الواحدة ‫hafez2.rar

السلام عليكم ورحمة الله ..ضع المعادلة الاولى فى الخلية G12 =LOOKUP(2;1/($B$4:$M$4>0);$B$4:$M$4) اما المعادلة الثانية فضعها فى الخلية F12 =INDEX($B$4:$H$4;MATCH($G$12;$B$4:$M$4;0)-1)

تفضل تم التصميم عملك سيكون غالبا على نموذجين اثنين نموذج ادخال الحوالات مقسوم الى جزئين : العلوي للاطلاع على آخر مبلغ تم صرفه ويظهر فيه الباقي السفلي لادخال الحوالة الجديدة ولاحظ انه يجب ادخال المتبقي السابق يدويا ( جميع الحقول اجبارية خاصة الادارة وتاريخ الحوالة ) تم البناء على اساس منطقي وهو انه لن يتم ادخال الحوالة لقسم محدد مرتين في اليوم ... فكان الاعتماد في اظهار الموظفين للتوزيع بناء على تاريخ ادخال الحوالة . عملت لك في جدول الاسماء حقل : نعم/ لا .. لتتمكن مستقبلا لو اردت حجب الحافز عن احد الاشخاص جرب الادخالات مرات عديدة وحاول تكتشف اذا يوجد ثغرات . في النهاية جدول التفاصيل هو اساس مخرجاتك يمكنك من خلاله استخراج اي تقرير يخطر على بالك ‫hafez1.rar

وعليكم السلام ورحمة الله وبركاته 🙂 اهلا وسهلا بك في المنتدى ، وللاستفادة القصوى من المنتدى ، رجاء مراجعة قوانين المنتدى: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة بشرائك النسخة الاصلية من الموقع الذي اشر اليه الاستاذ صالح او تقدر تستخدم طريقة اخرى: . جعفر

تفضل استاذ احمد..والله يعين الجدول على هذا الحقل المحسوب الدرجه.accdb

السلام عليكم أخي الكريم تفضل جواب طلبك باستخدام معادلة SUMIFS وإجراء تغييرات للحصول على نتيجة مقبولة =SUM(SUMIFS($B$2:$B$72;$C$2:$C$72;">="&$J$1;$C$2:$C$72;"<="&$J$2);SUMIFS($D$2:$D$72;$E$2:$E$72;">="&$J$1;$E$2:$E$72;"<="&$J$2)) حياكم الله والسلام عليكم دفعات الاشهر.xlsx

وعليكم السلام أخي أحمد ،، وضحت المسألة ،، ولكن هناك جدول ناقص في القاعدة التي أرسلتها وهو جدول الأسماء الذي ستطبق عليه .. قم بإضافته وأرفق البرنامج من جديد 🙂

مشاركة مع اخي جعفر ومن باب اثراء الموضوع عثرت على وظيفة تنسخ الصورة من النموذج ويمكن لصقها في برامج التواصل كــ الوتساب للصق استخدم ctrl+v photo.rar

وعليكم السلام ورحمة الله وبركاته أخي الكريم يمكنك التوصل إلى النتيجة بواسطة Pivot Table كما هو موضح في رابط الموضوع التالي: موضوع Pivot Table والنتيجة كما يلي: يمكنك الضغط على أي Total بجانب كل Department لتحصل على ورقة جديدة تظهر بها النتيجة مثل :اضغط على رقم 9953 نقرتين تحصل على جدول بقسم Baraha فقط في شيت جديد. والطريقة الثانية عبر التصفية التلقائية كما هو مبين أدناه: تقبل تحياتي العطرة والسلام عليكم. Time Attendance Details Report 15022022_125100.xls

الأستاذ العزيز الغالي أ / جعفر السلام عليكم ورحمة الله وبركاته وبعد في البداية أشكر لكم الردود الطيبة مع أنني أثقل عليكم جدا وأعلم أن ما تقدمونه تطوعا لأجل الله تعالى فقط . وأجد فيك معلما متألقا وأسارع بتطبيق كافة حلولك وبرامجك وهذا هو البرنامج الذي أعمل عليه وقمت بالتطوير عليه متتبعا في ذلك الدروس التي تقدمها والبرامج التي تطرحها حتى يلبي احتياجاتي وذلك بجهد المخلصين من العملاقة في الأكسيس مثلكم . للأهمية اسم المستخدم 1 والباس وارد 1 ولأنه كبير الحجم عن الإدراج في المرفقات وضع له رابط خاص https://dl.dropboxusercontent.com/u/61597795/hesabat.rar ملحوظة ستجد برنامجك مسقط التقارير في داخل البرنامج على الموضع في الصورة المرفقة وشرف لي تواجده معي