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

هذا الكلام موجه لك، ولا أعتقد أن فيه مايشير إلى الاستاذ @Khalf وطالما أني فتحت هذا الباب فسوف أسده بإذن الله.. في المرفق قمت بإجراء بعض التعديلات غير المخلة بما تفضل به الأستاذ @Khalf من الفكرة الرائعة.. وطبقت ما أشار إليه الأستاذ @jjafferr أعلاه.. هذا المرفق هو تطبيق لما سبق أن ذكرت من مقتراحات.. Colorizing (1).accdb

Insert a module and paste the following UDF Function AutoSum(rng As Range) As Variant Dim ws As Worksheet AutoSum = 0 Application.Volatile True For Each ws In Worksheets If Not ws Is Application.ThisCell.Parent Then AutoSum = AutoSum + ws.Range(rng.Address) End If Next ws End Function Then in Total worksheet you can use the formula like that (example in cell A9 put the formula) =AutoSum(A9)

In worksheet module Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 2 And Target.Column = 20 Then Application.Goto Cells(Target.Row + 1, 2) End If End Sub

الاخ الفاضل أبو عيد بارك الله لك في علمك هذا هو المطلوب لم اتوقع انه ممكن يتعمل بالمعادلات ... جزاكم الله خير الاخ الفاضل قلب الاسد (Lionheart) ماشاء الله كود رائع وسريع التنفيذ بارك الله لك في علمك هذا هو المطلوب ... جزاكم الله خير

Sub Test() Dim a, temp, dict As Object, buy As Double, sell As Double, i As Long, x As Long Set dict = CreateObject("Scripting.Dictionary") With Sheets("Sheet1").Cells(2).CurrentRegion a = .Value: ReDim temp(1 To UBound(a), 1 To 3) For i = 2 To UBound(a) If Not dict.Exists(a(i, 1)) Then dict.Add a(i, 1), "" buy = Application.WorksheetFunction.SumIfs(.Columns(7), .Columns(1), a(i, 1), .Columns(2), "BUY") sell = Application.WorksheetFunction.SumIfs(.Columns(7), .Columns(1), a(i, 1), .Columns(2), "SELL") If buy > sell Then x = x + 1: temp(x, 1) = a(i, 1): temp(x, 2) = buy: temp(x, 3) = sell End If Next i End With With Sheets("Sheet2") .Columns(1).ClearContents .Range("A2").Value = "Market" .Range("A3").Resize(x, 1) = temp End With End Sub

وعليكم السلام ورحمة الله وبركاته تفضل جرب هذا book1 معدل.xlsx

السلام عليكم الطريقة كانت عبارة عن نموذج لربط الستايل/ النمط بالكتاب ... وسميت النموذج Stylecolor عند تسجيل كتاب جديد يتبع النمط وتخزن قيمة معرف النمط في حقل في جدول Books بواسطة الدالة DlookUp نصل إلى حقل تخزين معرفات الأنماط لكن الذي توقفت عنده هو كيفية استخدام الدالة Mid أو Split لاستخراج أرقام الأنماط واستدعاء بقية محددات الوظيفة / Function عن طريق الدالة DlookUp وهو ما استغرق مني وقتاً طويلاً دون نتيجة أظن أني لن أحقق شيئاً في هذه الطريقة التي رسمتها بمخيلتي، على الأقل في حدودي معرفتي الحالية. أستاذ @أبو إبراهيم الغامدي لقد شاهدت مرفقكم، وأثار تساؤلي وجود دالتين بنفس الاسم AnnotationColoring إحداهما Public، هل من الممكن شرح هذه النقطة. جزاكم الله كل خير ... ColorizingAAA.accdb

استخدم هذا الكود :::: If DCount("[ser]", "find", "[name_1] ='" & Me![myfind] & "' ") > 0 Then MsgBox "هذا الشخص موجود", vbCritical, "عملية خاطئة" Else MsgBox "الاسم غير موجود" End If

نحن في انتظارك!

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

ما انا عملتها لك .. وحضرتك الظاهر ماشفت المرفق

في مربع النص لا تنسى علامة ال = =Sum([Field1])

عملت لك استعلامين الاستعلام الاول يظهر الكل والاستعلام الثاني يظهر المكملين Data_BaseD.mdb

مرفق مفيد فعلا جربته فيه افكار رائعة ., جزاكم الله خير

جزيت خيرا اخى الكريم

تفضل جرب المرفق الخاص بك ملف جديد (2).xlsm

تحياتي لك أخي العزيز 🌹

وعليكم السلام هذه معادلة لحساب الضريبة Function irgne(x As Double) As Double Dim r1, r2, k As Double x = (Int(x / 10)) * 10 If x <= 30000 Then irgne = 0 Else '---------------Part1------------------ r1 = Round( _ IIf(x <= 40000, (x - 20000) * 0.23, _ IIf(x <= 80000, (x - 40000) * 0.27 + 4600, _ IIf(x <= 160000, (x - 80000) * 0.3 + 15400, _ IIf(x <= 320000, (x - 160000) * 0.33 + 39400, _ (x - 320000) * 0.35 + 92200)))), 1) '---------------Part2---------------- k = r1 * 0.4 r2 = _ IIf(Round(k, 2) > 1500, Round(r1 - 1500, 1), _ IIf(Round(k, 2) < 1000, Round(r1 - 1000, 1), _ Round(r1 * 0.6, 2))) '---------------Part3---------------- irgne = Round(IIf(x <= 35000, Round(r2 * 137 / 51 - 27925 / 8, 1), r2), 1) End If End Function

وعليكم السلام .. انظر للمرفق.. عملت لك الضريبة في استعلام وليس حقل محسوب في الجدول طبعا تستطيع عمله في الجدول لكن لا ينصح به tax.accdb

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

تفضل جرب هذا مقارنة معدل2.xlsx

صدقت استاذي الفاضل طريقة سهلة ومرنة وبديعة وكونه توجد بعض الكتب عندي تتطلب تعديلا او معاملة خاصة لا يقلل من جمالية وجودة هذا الكود الذي تفضل به استاذنا @Khalf وقبل ان أحاول تفصيل ما عنيته بقولي (توجد بعض الكتب عندي تتطلب تعديلا ..) أحب ان ابدأ بموضوع ان الألوان التي تظهر عندي ليست هي التي تم اختيارها فأظن انني مسكت طرف الخيط كما يقال لعل السبب هو اني استخدم النسخة العربية وانعكاس اليمين والشمال سألت نفسي لماذا اذا اخترت اللون الازق (#FF0000) يظهر الأحمر (#0000FF) وبالعكس أيضا بينما في اللون الأخضر (#00FF00) لا توجد هذه المشكلة فقمت بعكس هذه الرموز يدويا (اليمين والشمال) في النموذج بعد اختيار اللون فظهر اللون المطلوب الذي تم اختياره وفعلت ذلك في بقية الألوان وحصلت في كل مرة على النتيجة المطلوبة هذا طرف الخيط إن لم اكن مخطئا 🙂 اما تطبيقه برمجيا فعند الأساتذة الافاضل والآن ساحاول ان أشرح إشكالية تطبيق الكود الموحد على جميع الكتب كما ذكرت في مشاركة سابقة ان أكثر الكتب تستخدم هذه الاقواس {} للآيات وهناك العديد من الكتب تستخدم (( )) للأحاديث أو الاقوال او المتون المشروحة لكن هناك بعض الكتب تجعل الايات بين (( )) وتستخدم هذه الاقواس {} لعبارات أخرى كتخريج الاحاديث {متفق عليه} وغير ذلك فاذا جعلت معيار تلوين الايات بالاحمر هذين القوسين {} فلن يناسب هذا تلك الكتب الأخرى التي تستخدم هذين القوسين لعبارات أخرى وسيتم تلوينها بالاحمر واذا جعلت المعيار (( )) ليناسب تلك الكتب فلن يتم تلوين الايات في أكثر الكتب التي تستخدم {} واذا استخدمتهما معا للتلوين بالاحمر فسيتم تلوين عبارات غير مطلوب تلوينها ولن تتميز الايات باللون المطلوب وما قيل عن الاقواس يقال أيضا عن العبارات فقد تكون هناك عبارات مطلوب تلوينها في بعض الكتب فقط وليس في كلها الطريقة التي عالجت بها هذه الإشكالية هي انني أنشأت جدولا آخر لمعايير التلوين (criteriaColor2) ووضعت فيه فقط المعاير التي تناسب الكتاب (book2) مع تعديل الكود Set rst = db.OpenRecordset("criteriaColor2") ونجحت المحاولة لكن هذه الطريقة تتطلب انشاء جدول معايير جديد لكل كتاب له وضع خاص وبعد التأمل واعادة النظر والتدقيق في الكود حاولت بطريقة أخرى مختلفة في كتاب (book3) حاولت ان اجعل التلوين يتم من داخل نموذج الكتاب نفسه دون استخدام (criteriaColor) فجعلت الكود هكذا Dim s1, s2, i As String s1 = "((" s2 = "))" i = "(فصل)" Me.txtnass = Replace(Me.txtnass, s1, "<b><font color=red" & ">" & s1) Me.txtnass = Replace(Me.txtnass, s2, s2 & "</font></b>") Me.txtnass = Replace(Me.txtnass, i, "<b><font color=green" & ">" & i & "</font></b>") ونجح الامر ايضا هذه محاولاتي وبانتظار ما عند الاساتذة الافاضل Colorizing3.accdb

مشاركة مع الحبايب يا ليت تعطوني رايكم تحياتي MyFolder.accdb

ملف ممتاز بارك الله فيك أستاذ عادل وزادك الله من فضله وكل عام وانتم بخير

اعداد كشوفات مدرسية باختيار روؤس الاعمدة عن طريق فورم بطريقة ابسط للفهم وسهولة نقلها الى اي ملف مع تضبيط الطباعة مع الشرح اعداد كشوفات مدرسية باكواد سهلة التغيير والتي تجعل استخدامه ونقلة الى ملف آخر للعمل عليه بشكل مبسط وتتم التغييرات في مكان واحد في اول الكود هنا : '====================================================== ' اول صف للتقرير Private Const iRow As Integer = 4 '------------------------------------------------------ ' اسم ورقة التقارير Private Const Sh_Report As String = "التقرير" '------------------------------------------------------ ' اسم ورقة البيانات Private Const Sh_MyDate As String = "بيانات اساسية" '------------------------------------------------------ ' تعيين نطاق الخلايا في ورقة البيانات ' ويشمل رؤوس الاعمدة Private Const MyRng_MyDate As String = "A5:X1000" '====================================================== ويمكن يستخدم لاي كشوفات وتقارير او غيره و ساقوم بشرح هذا العمل على شكل دفعات رويدا رويدا وسوف نبدأ اليوم بارفاق الملف وسيتبعه الشرح ان شاء الله خبور خير اعداد تقارير مدرسية.rar