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

Insert module and paste the following code Sub Highlight_Names_In_Similar_Groups() Dim groupColors(), ws As Worksheet, sh As Worksheet, colRange As Range, cell As Range, sName As String, lr As Long, i As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(2) Set sh = ThisWorkbook.Worksheets(3) Set colRange = ws.Range("E12:N20") lr = sh.Cells(sh.Rows.Count, 3).End(xlUp).Row groupColors = RandomColors(colRange.Columns.Count, True) sh.Columns("C:F").Interior.Color = xlNone For Each cell In colRange.Cells sName = Trim(cell.Value) If sName <> Empty Then For i = 3 To lr If Trim(sh.Cells(i, 3).Value) = sName And sh.Cells(i, 3).Interior.Color <> xlNone Then sh.Cells(i, 4).Resize(, 3).Interior.Color = groupColors(cell.Column - 4) End If Next i End If Next cell Application.ScreenUpdating = True End Sub Function RandomColors(ByVal numColors As Long, Optional ByVal lightColorsOnly As Boolean = False) Dim isUnique As Boolean, i As Long, j As Long ReDim colors(1 To numColors) For i = 1 To numColors Do If lightColorsOnly Then colors(i) = RGB(Int(Rnd() * 128) + 128, Int(Rnd() * 128) + 128, Int(Rnd() * 128) + 128) Else colors(i) = RGB(Int(Rnd() * 256), Int(Rnd() * 256), Int(Rnd() * 256)) End If isUnique = True For j = 1 To i - 1 If colors(i) = colors(j) Then isUnique = False: Exit For Next j Loop Until isUnique Next i RandomColors = colors End Function Then in worksheet module of the first worksheet add this part at the end of the existing code Next c End If If Target.Address = "$C$2" Then Call Highlight_Names_In_Similar_Groups End Sub

الكود موجود في التنسيق الشرطي للحقل بالتوفيق https://wayprograms.blogspot.com/search/label/اكسس

وقد تفيدكم الافكار فى هذا المثال من حيث - اخراج المستخدمين - منع دخول المستخدمين لحين انتهاء الادمن من عمل الاصلاح

THANKS ALOT

احسنتم @Moosak & @kkhalifa1960 طريقة بابا ..ونانا ..جميلتان ☺️

كل عام وانت بخير اخي ابو عبد الرحمن .. المشكلة في نسخة الاوفيس ..لديك نواة 32 اعمل ptrsafe بعد Declare

ممكن أشارك اساتذتي بهذا المرفق . 1- استعلام1 مماثل بما تقدم به اساتذتي. 2- استعلام2 هو الجديد ويعطي نفس النتائج . DD131mdb.mdb

جزاك الله الف خير لقد اشتغل الكود الحمد لله لكن عملت فيه تعديل يظهر كالتالى لانه لم يعمل بدون التعديل فرجاء توضيح السبب لو تكرمت 🙂 Public Function Frm1_or_Frm2() As String If CurrentProject.AllForms("issue").IsLoaded = True Then Frm1_or_Frm2 = [Forms]![Issue]![QNo].Value ElseIf CurrentProject.AllForms("quud").IsLoaded = True Then Frm1_or_Frm2 = [Forms]![Quud]![QNo].Value ElseIf CurrentProject.AllForms("recepit").IsLoaded = True Then Frm1_or_Frm2 = [Forms]![Recepit]![QNo].Value Else Frm1_or_Frm2 = "" End If End Function اضفت . value

تفضل <><><><><><> احصاء عدد الصفوف.accdb

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته 🙂 درسنا اليوم عبارة عن فكرة تجميلية لقاعدة البيانات وإظهار شاشة إنتظار عند الإنتقال بين النماذج.. فكرة لمعت وحبيت أوثقها قبل أن تطير بلا عودة 😅 متابعة ممتعة 🙂 حمل المثال من المرفقات .. Waiting Screen.accdb

You can use this formula directly =SUM($F$3:F3)>الرئيسي!$D$3

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

وذاك مثال رائع كذلك من مكتبتى وناطق باللغتين العربية والانجليزية القاعدة ليست من تصميمى حصلتها من احد المنتديات الاجنبية Translate&Speak_v3.accdb

والثانوي العام

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